Asm994a TMS99000 Assembler - v3.010
* Asm994a Generated Register Equates
*
0000 0000 R0 EQU 0
0000 0001 R1 EQU 1
0000 0002 R2 EQU 2
0000 0003 R3 EQU 3
0000 0004 R4 EQU 4
0000 0005 R5 EQU 5
0000 0006 R6 EQU 6
0000 0007 R7 EQU 7
0000 0008 R8 EQU 8
0000 0009 R9 EQU 9
0000 000A R10 EQU 10
0000 000B R11 EQU 11
0000 000C R12 EQU 12
0000 000D R13 EQU 13
0000 000E R14 EQU 14
0000 000F R15 EQU 15
*
1 ; _____ _ _____ _ _
2 ; |_ _|_ _ _ __| |__ ___ | ___|___ _ __| |_| |__
3 ; | | | | | | '__| '_ \ / _ \| |_ / _ \| '__| __| '_ \
4 ; | | | |_| | | | |_) | (_) | _|| (_) | | | |_| | | |
5 ; |_| \__,_|_| |_.__/ \___/|_| \___/|_| \__|_| |_|
6 ; ################################################
7 ; TurboForth
8 ; (C) Mark Wills 2009-2012
9 ; Written in TMS9900 machine code for the TI-99/4A
10 ; May the Forth be with you.
11 ; ################################################
12 ; ____ _ ___
13 ; | __ ) __ _ _ __ | | __ / _ \
14 ; | _ \ / _` | '_ \| |/ / | | | |
15 ; | |_) | (_| | | | | < | |_| |
16 ; |____/ \__,_|_| |_|_|\_\ \___/
17 ;
18 ; This is bank 0 - the main bank, containing:
19 ; Forth dictionary
20 ; Any words written in Forth
21 ; Console routines (keyboard, scrolling, cursor etc)
22 ;
23 ; Due to memory contraints, some dictionary entries are stub entries
24 ; containing only the dictionary entry and a call into bank 1 where the
25 ; main code resides. I have tried to keep routines that need to run quickly
26 ; (i.e. without the overhead of a bank-switch/branch and bank-switch/return
27 ; in this bank.
28
29 ; _ _ _
30 ; | | | | | |
31 ; | |__| | ___ __ _ __| | ___ _ __
32 ; | __ |/ _ \/ _` |/ _` |/ _ \ '__|
33 ; | | | | __/ (_| | (_| | __/ |
34 ; |_| |_|\___|\__,_|\__,_|\___|_|
35
36 aorg >6000 ; cartridge rom
37
38 ; cartridge ROM header
39
40 6000 AA byte >aa ; standard header
41 6001 0C byte >0c ; version number
42 6002 01 byte >01 ; number of programs
43 6003 00 byte >00 ; not used
44 6004 0000 data >0000 ; pointer to power-up list
45 6006 600C data menu ; pointer to program list
46 6008 0000 data 0 ; pointer to DSRL list
47 600A 0000 data 0 ; pointer to subprogram list
48
49 600C 6026 menu data menu40 ; pointer to next menu item
50 600E 605C data start80 ; code entry point
51 6010 14 byte 20 ; length of text
52 6011 5455 text 'TURBOFORTH 80 COLUMN'
52 6013 5242
52 6015 4F46
52 6017 4F52
52 6019 5448
52 601B 2038
52 601D 3020
52 601F 434F
52 6021 4C55
52 6023 4D4E
53 6025 0000 even
54 6026 0000 menu40 data 0 ; no more menu entries
55 6028 6052 data start40 ; code entry point (see 0-01-Startup.a99)
56 602A 11 byte 17 ; length of text
57 602B 5455 mtext text 'TURBOFORTH V1.2.1:1 (c) 2015 Mark Wills'
57 602D 5242
57 602F 4F46
57 6031 4F52
57 6033 5448
57 6035 2056
57 6037 312E
57 6039 322E
57 603B 313A
57 603D 3120
57 603F 2863
57 6041 2920
57 6043 3230
57 6045 3135
57 6047 204D
57 6049 6172
57 604B 6B20
57 604D 5769
57 604F 6C6C
57 6051 73
58 even
59
60 ; 40 column mode entry point
61 6052 02E0 start40 lwpi wkspc
61 6054 8300
62 6056 04E0 clr @sumode
62 6058 A078
63 605A 1009 jmp startB0 ; defined in 0-01-Startup.a99
64
65 ; 80 column mode entry point
66 605C 02E0 start80 lwpi wkspc
66 605E 8300
67 6060 0200 li r0,2
67 6062 0002
68 6064 C800 mov r0,@sumode
68 6066 A078
69 6068 1002 jmp startB0 ; defined in 0-01-Startup.a99
70
71 ; codes for bank 0 and bank 1 - used by the interrupt handler to determine which
72 ; bank to return to after processing an interrupt.
73 ; Set by the VDP routines (see 0-22-VDP.a99)
74 ; DO NOT MOVE THESE! Identical definitions are made in bank 1, and they MUST
75 ; be at identical addresses!
76 606A 6002 bank0 data >6002 ; code to select bank 0
77 606C 6000 bank1_ data >6000 ; code to select bank 1
78
79
80 ; General Equates
81 0000 8300 wkspc equ >8300 ; workspace pointer
82 0000 0000 link equ 0 ; chain of links
83 0000 837C gplst equ >837c ; gpl status byte
84 0000 8375 keyin equ >8375 ; location of ascii key pressed (via KSCAN)
85 0000 009D quitky equ 157 ; key code for cold reset (157=CTRL and =)
86 0000 834A fac equ >834a ; FAC
87 0000 83C4 ISR equ >83c4 ; address of isr hook
88
89 0000 0003 pc equ r3 ; friendly name for program counter register
90 0000 0004 stack equ r4 ; friendly name for data stack register
91 0000 0005 rstack equ r5 ; friendly name for return stack register
92 0000 000C NEXT equ r12 ; friendly name for NEXT routine
93
94 0000 8000 immed equ >8000 ; flag for immediate words
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-01-Startup.a99'
*
1 ; _____ _ _
2 ; / ____| | | |
3 ; | (___ | |_ __ _ _ __| |_ _ _ _ __
4 ; \___ \| __|/ _` | '__| __| | | | '_ \
5 ; ____) | |_| (_| | | | |_| |_| | |_) |
6 ; |_____/ \__|\__,_|_| \__|\__,_| .__/
7 ; | |
8 ; |_|
9 ; STARTUP - general initialisation code for bank 0
10 ; and a few high level Forth kernal words for starting
11 ; the interpreter, cold starting, etc
12
13 ;[ START
14 606E 0300 startB0 limi 0 ; no interrupts thank-you, we're British
14 6070 0000
15
16 6072 04E0 clr @>6000 ; we're now in bank 1
16 6074 6000
17 ; note, bank 1 has identical code at these addresses so we
18 ; can safely bank switch
19 6076 0460 b @init ; init is defined in 1-15-Initialise.a99
19 6078 7B76
20
21 607A 020C afteri li r12,_next ; we'll use r12 as a pointer to NEXT
21 607C 8326
22 607E 0203 li pc,cstart ; setup Forth instruction pointer (R3)
22 6080 60D4
23 6082 045C b *r12 ; call NEXT (start execution)
24 ; from this point we're actually running in forth
25 ;]
26
27 ; pc = instruction pointer (R3)
28 ; stack = data stack pointer (R4)
29 ; rstack = return stack pointer (R5)
30
31 ;[ space saving routines... these replace common phrases found in the source
32 ; The following four routines save 2 bytes each time they are used
33 6084 6086 lit0 data $+2 ; push 0 to stack
34 6086 0644 dect stack
35 6088 04D4 clr *stack
36 608A 045C b *next
37
38 608C 8320 lit1 data docol,lit,1,exit ; push 1 to stack
38 608E 70B2
38 6090 0001
38 6092 832C
39 6094 8320 lit8 data docol,lit,8,exit ; push 8 to stack
39 6096 70B2
39 6098 0008
39 609A 832C
40
41 609C 609E litm1 data $+2 ; push -1 to stack
42 609E 0644 dect stack
43 60A0 0714 seto *stack
44 60A2 045C b *next
45
46 ; another common phrase is COMPILE BRANCH
47 60A4 8320 combra data docol,compile,branch,exit
47 60A6 7262
47 60A8 65E4
47 60AA 832C
48
49 ; COMPILE LIT COMMA
50 60AC 8320 clc data docol,compile,lit,comma,exit
50 60AE 7262
50 60B0 70B2
50 60B2 70CC
50 60B4 832C
51
52 ; Alternative to TYPE. A typical phrase is LIT LIT TYPE
53 ; This routine allows the above phrase to be replaced with TOTERM
54 ; Saving 4 bytes each time it is used. Net saving ~80 bytes.
55 60B6 8320 toterm data docol,term1,type,exit
55 60B8 60BE
55 60BA 6C94
55 60BC 832C
56 60BE 60C0 term1 data $+2
57 60C0 C055 mov *rstack,r1 ; get address of address of text
58 60C2 C0A1 mov @2(r1),r2 ; get length of text
58 60C4 0002
59 60C6 0644 dect stack ; create stack entry
60 60C8 C511 mov *r1,*stack ; push address
61 60CA 0644 dect stack ; create stack entry
62 60CC C502 mov r2,*stack ; push length
63 ; change the address on the return stack to move past
64 ; the text address and text length, which are in-line...
65 60CE 05D5 inct *rstack ; move past address
66 60D0 05D5 inct *rstack ; move past length
67 60D2 045C b *next
68 ;]
69
70 ;[ COLD START
71 ; This routine is called when the system starts for the first time.
72 60D4 60D6 cstart data bootup
73 60D6 8320 bootup data docol,synth ; check if speech synth is fitted
73 60D8 60FE
74 ; the graphics mode is loaded by the cart startup menus
75 60DA 70B2 data lit,sumode,fetch,gmode ; set appropriate graphics mode
75 60DC A078
75 60DE 6830
75 60E0 795E
76 60E2 60B6 data toterm,mtext,39,cr ; type title to screen
76 60E4 602B
76 60E6 0027
76 60E8 6E92
77 60EA 6E62 data keyq,cboot ; scan keyboard and call cboot
77 60EC 6106
78 60EE 65F6 data zbrnch,skipld ; skip bootloader if enter key was pressed
78 60F0 60FC
79 60F2 608C data lit1,load ; boot from disk - load block 1
79 60F4 7C18
80 60F6 70B2 data lit,doboot,store0 ; reset booting flag
80 60F8 A04E
80 60FA 6892
81 60FC 7464 skipld data ab0rt ; call QUIT.
82 60FE 6100 synth data $+2 ; check if speech synth is fitted
83 6100 06A0 bl @bank1
83 6102 8332
84 6104 6684 data isspch ; see 1-05-speech.a99
85
86 ; permit booting from DSKx where x is any ASCII character
87 ; To boot from something other than DSK1 just hold down the appropriate key at
88 ; boot-time.
89 6106 6108 cboot data $+2
90 6108 06A0 bl @bank1
90 610A 8332
91 610C 7E9C data _cboot ; defined in 1-15-Initialise.a99
92 ;]
93
94 ;[ EXIT -- C,79
95 ; Compiled within a colon definition such that when executed, that colon
96 ; definition returns control to the definition that passed control to it by
97 ; returning control to the return point on the top of the return stack.
98 ; An error condition exists if the top of the return stack does not contain a
99 ; valid return point.
100 ; See: ; "stack, return" "9.3 Return Stack"
101 ;
102 ; Note: This word is the last word in the dictionary. Consequently it's link
103 ; field has a value of 0. FIND uses this to determine if it has searched every
104 ; word in the dictionary.
105 610E 0000 exith data 0,4
105 6110 0004
106 6112 4558 text 'EXIT'
106 6114 4954
107 6116 6118 exitt data $+2
108 6118 0460 b @exit+2
108 611A 832E
109 ;]
110
111 ;[ QUIT -- 79
112 ; Clears the return stack, sets interpret state, accepts new input from the
113 ; current input device, and begins text interpretation. No message is
114 ; displayed.
115 611C 610E quith data exith,4
115 611E 0004
116 6120 5155 text 'QUIT'
116 6122 4954
117 6124 8320 quit data docol
118 6126 70B2 quitlp data lit,>0500,lit,keydev,store ; set keyscan code
118 6128 0500
118 612A 70B2
118 612C A022
118 612E 6852
119 6130 6154 data rrstack ; reset return stack
120 6132 773E data tib_,fetch,lit,80,expect ; get some input
120 6134 6830
120 6136 70B2
120 6138 0050
120 613A 69D2
121 ; data ghere,lit,80,expect
122 613C 72FE data interp ; call INTERPRET
123 613E 73CC data stkuf ; check for stack underflow
124 6140 60B6 data toterm,oktxt,3 ; type OK
124 6142 6150
124 6144 0003
125 6146 6240 data depth,dot,cr ; display stack depth
125 6148 783C
125 614A 6E92
126 614C 65E4 data branch,quitlp ; repeat endlessly
126 614E 6126
127 6150 6F6B oktxt text 'ok:'
127 6152 3A
128 6153 0000 even
129 6154 6156 rrstack data $+2
130 6156 0205 li rstack,retstk ; reset return stack pointer
130 6158 A28A
131 615A 045C b *next
132 ;]
133
134 ;[ COLD ( -- )
135 ; performs a cold reset of the system
136 615C 611C coldh data quith,4
136 615E 0004
137 6160 434F text 'COLD'
137 6162 4C44
138 6164 6166 data $+2
139 6166 0460 cold b @startB0 ; restart the whole shebang
139 6168 606E
140 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-02-Stack.a99'
*
1 ; _____ _ _ __ __ _
2 ; / ____| | | | \ \ / / | |
3 ; | (___ | |_ __ _ ___| | __ \ \ /\ / /___ _ __ __| |___
4 ; \___ \| __|/ _` |/ __| |/ / \ \/ \/ // _ \| '__/ _` / __|
5 ; ____) | |_| (_| | (__| < \ /\ /| (_) | | | (_| \__ \
6 ; |_____/ \__|\__,_|\___|_|\_\ \/ \/ \___/|_| \__,_|___/
7 ; Core words pertaining to data and return stack manipulation
8
9
10 ;[ DROP 16b -- 79
11 ; 16b is removed from the stack.
12 616A 615C droph data coldh,4 ; link to previous word and length of word
12 616C 0004
13 616E 4452 text 'DROP' ; name of word
13 6170 4F50
14 6172 838A drop data _drop ; code is in high-speed ram.
15 ; see 1-15-Initialise.a99
16 ;]
17
18 ;[ SWAP 16b1 16b2 -- 16b2 16b1 79
19 ; The top two stack entries are exchanged.
20 6174 616A swaph data droph,4
20 6176 0004
21 6178 5357 text 'SWAP'
21 617A 4150
22 617C 835C swap data _swap ; code is in high-speed ram.
23 ; see 1-15-Initialise.a99
24 ;]
25
26 ;[ DUP 16b -- 16b 16b 79 "dupe"
27 ; Duplicate 16b.
28 617E 6174 duph data swaph,3
28 6180 0003
29 6182 4455 text 'DUP '
29 6184 5020
30 6186 8382 dup data _dup ; code is in high-speed ram.
31 ; see 1-15-Initialise.a99
32 ;]
33
34 ;[ ROT 16b1 16b2 16b3 -- 16b2 16b3 16b1 79 "rote"
35 ; The top three stack entries are rotated, bringing the deepest to the top.
36 6188 617E roth data duph,3
36 618A 0003
37 618C 524F text 'ROT '
37 618E 5420
38 6190 6192 rot data $+2
39 6192 C1A4 mov @4(stack),r6 ; save x1
39 6194 0004
40 6196 C924 mov @2(stack),@4(stack) ; move x2 backwards on stack
40 6198 0002
40 619A 0004
41 619C C914 mov *stack,@2(stack) ; move x3 bacwards on stack
41 619E 0002
42 61A0 C506 mov r6,*stack ; put x1 on top of stack
43 61A2 045C b *next
44 ;]
45
46 ;[ -ROT 16b1 16b2 16b3 -- 16b3 16b1 16b2
47 ; The top three stack entries are rotated, sending the top item to the deepest
48 ; poisition
49 61A4 6188 nroth data roth,4
49 61A6 0004
50 61A8 2D52 text '-ROT'
50 61AA 4F54
51 61AC 61AE nrot data $+2
52 61AE C194 mov *stack,r6 ; save x3
53 61B0 C524 mov @2(stack),*stack ; move x2 forwards on stack
53 61B2 0002
54 61B4 C924 mov @4(stack),@2(stack) ; move x1 forwards on stack
54 61B6 0004
54 61B8 0002
55 61BA C906 mov r6,@4(stack) ; put x3 on bottom
55 61BC 0004
56 61BE 045C b *next
57 ;]
58
59 ;[ OVER 16b1 16b2 -- 16b1 16b2 16b3 79
60 ; 16b3 is a copy of 16b1.
61 61C0 61A4 overh data nroth,4
61 61C2 0004
62 61C4 4F56 text 'OVER'
62 61C6 4552
63 61C8 838E over data _over ; code is in high-speed ram.
64 ; see 1-15-Initialise.a99
65 ;]
66
67 ;[ NIP 16b1 16b2 -- 16b2
68 ; 16b1 is removed from the stack
69 61CA 61C0 niph data overh,3
69 61CC 0003
70 61CE 4E49 text 'NIP '
70 61D0 5020
71 61D2 61D4 nip data $+2
72 61D4 C534 mov *stack+,*stack ; copy 16b2 and perform pop
73 61D6 045C b *next
74 ;]
75
76 ;[ TUCK 16b1 16b2 -- 16b2 16b1 16b2
77 ; places a copy of 16b2 at the third data stack position.
78 ; 16b1 and 16b2 move upwards.
79 61D8 61CA tuckh data niph,4
79 61DA 0004
80 61DC 5455 text 'TUCK'
80 61DE 434B
81 61E0 61E2 tuck data $+2
82 61E2 0644 dect stack
83 61E4 C524 mov @2(stack),*stack
83 61E6 0002
84 61E8 C924 mov @4(stack),@2(stack)
84 61EA 0004
84 61EC 0002
85 61EE C914 mov *stack,@4(stack)
85 61F0 0004
86 61F2 045C b *next
87 ;]
88
89 ;[ ?DUP 16b -- 16b 16b 79 "question-dupe"
90 ; or: 0 -- 0. Duplicate 16b if it is non-zero.
91 61F4 61D8 dup0h data tuckh,4
91 61F6 0004
92 61F8 3F44 text '?DUP'
92 61FA 5550
93 61FC 61FE qdup data $+2
94 61FE C514 mov *stack,*stack ; set EQ bit in status register if TOS=0
95 6200 1303 jeq qdupx ; jump if TOS=0 and exit
96 6202 0644 dect stack ; create stack entry
97 6204 C524 mov @2(stack),*stack ; copy tos
97 6206 0002
98 6208 045C qdupx b *next
99 ;]
100
101 ;[ PICK +n -- 16b 83
102 ; 16b is a copy of the +nth stack value, not counting +n itself.
103 ; {0..the number of elements on stack-1}
104 ; 0 PICK is equivalent to DUP
105 ; 1 PICK is equivalent to OVER
106 620A 61F4 pickh data dup0h,4
106 620C 0004
107 620E 5049 text 'PICK'
107 6210 434B
108 6212 6214 pick data $+2
109 6214 06A0 bl @bank1
109 6216 8332
110 6218 78B8 data _pick
111 ;]
112
113 ;[ >< ( xy -- yx )
114 ; Swaps bytes in the top data stack cell. For example $1234 becomes $3412
115 621A 620A swpbh data pickh,2
115 621C 0002
116 621E 3E3C text '><'
117 6220 6222 swpb_ data $+2
118 6222 06D4 swpb *stack ; swap bytes in TOS
119 6224 045C b *next
120 ;]
121
122 ;[ ROLL +n -- 83
123 ; The +nth stack value, not counting +n itself is first removed and then
124 ; transferred to the top of the stack, moving the remaining values into the
125 ; vacated position.
126 ; {0..the number of elements on the stack-1}
127 ; 2 ROLL is equivalent to ROT
128 ; 0 ROLL is a null operation
129 6226 621A rollh data swpbh,4
129 6228 0004
130 622A 524F text 'ROLL'
130 622C 4C4C
131 622E 6230 roll data $+2
132 6230 06A0 bl @bank1
132 6232 8332
133 6234 78C6 data _roll
134 ;]
135
136 ;[ DEPTH -- +n 79
137 ; +n is the number of 16-bit values contained in the data stack before +n was
138 ; placed on the stack.
139 6236 6226 depthh data rollh,5
139 6238 0005
140 623A 4445 text 'DEPTH '
140 623C 5054
140 623E 4820
141 6240 6242 depth data $+2
142 6242 06A0 bl @bank1
142 6244 8332
143 6246 78E8 data _depth
144 ;]
145
146 ;[ .S ( -- )
147 ; produce non-destructive stack dump to the screen.
148 6248 6236 ndsh data depthh,2
148 624A 0002
149 624C 2E53 text '.S'
150 624E 8320 dots data docol,depth,zbrnch,dotst
150 6250 6240
150 6252 65F6
150 6254 627C
151 6256 608C data lit1,depth,sub1
151 6258 6240
151 625A 62C2
152 625C 66F6 data do,dotst
152 625E 627C
153 6260 679A dots1 data geti,sub1,pick
153 6262 62C2
153 6264 6212
154 6266 7602 data usignd,fetch,zbrnch,dots3
154 6268 6830
154 626A 65F6
154 626C 6274
155 626E 782C data udot,branch,dots4
155 6270 65E4
155 6272 6276
156 6274 783C dots3 data dot
157 6276 609C dots4 data litm1
158 6278 6778 data ploop,dots1
158 627A 6260
159 627C 60B6 dotst data toterm,dottxt,5
159 627E 6284
159 6280 0005
160 6282 832C data exit
161 6284 3C54 dottxt text '
161 6286 4F50
161 6288 2020
162 ;]
163
164 ; RETURN STACK WORDS:
165
166 ;[ >R 16b -- C,79 "to-r"
167 ; Transfers 16b to the return stack.
168 628A 6248 rspshh data ndsh,2
168 628C 0002
169 628E 3E52 text '>R'
170 6290 6292 rspush data $+2
171 6292 0645 dect rstack ; move return stack to the next position
172 6294 C574 mov *stack+,*rstack ; pop word on data stack to return stack
173 6296 045C b *next
174 ;]
175
176 ;[ R@ -- 16b C,79 "r-fetch"
177 ; 16b is a copy of the top of the return stack.
178 6298 628A rsch data rspshh,2
178 629A 0002
179 629C 5240 text 'R@'
180 629E 62A0 rsc data $+2
181 62A0 0644 dect stack ; move forward on data stack
182 62A2 C515 mov *rstack,*stack ; copy word from return stack to data stack
183 62A4 045C b *next
184 ;]
185
186 ;[ R> -- 16b C,79 "r-from"
187 ; 16b is removed from the return stack and transferred to the data stack.
188 62A6 6298 rspoph data rsch,2
188 62A8 0002
189 62AA 523E text 'R>'
190 62AC 62AE rspop data $+2
191 62AE 0644 dect stack ; move forward on data stack
192 62B0 C535 mov *rstack+,*stack ; pop top of return stack to data stack
193 62B2 045C b *next
194 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-03-Math.a99'
*
1 ; __ __ _ _ __ __ _
2 ; | \/ | | | | | \ \ / / | |
3 ; | \ / | __ _| |_| |__ \ \ /\ / /___ _ __ __| |___
4 ; | |\/| |/ _` | __| '_ \ \ \/ \/ // _ \| '__/ _` / __|
5 ; | | | | (_| | |_| | | | \ /\ /| (_) | | | (_| \__ \
6 ; |_| |_|\__,_|\__|_| |_| \/ \/ \___/|_| \__,_|___/
7
8
9 ;[ 1+ w1 -- w2 79 "one-plus"
10 ; w2 is the result of adding one to w1 according to the operations of +
11 62B4 62A6 plus1h data rspoph,2
11 62B6 0002
12 62B8 312B text '1+'
13 62BA 8396 plus1 data _plus1 ; code is in high-speed ram.
14 ; see 1-15-Initialise.a99
15 ;]
16
17 ;[ 1- w1 -- w2 79 "one-minus"
18 ; w2 is the result of subtracting one from w1 according to the operation of -
19 62BC 62B4 sub1h data plus1h,2
19 62BE 0002
20 62C0 312D text '1-'
21 62C2 62C4 sub1 data $+2
22 62C4 0614 dec *stack
23 62C6 045C b *next
24 ;]
25
26 ;[ 2+ w1 -- w2 79 "two-plus"
27 ; w2 is the result of adding two to w1 according to the operation of +
28 62C8 62BC plus2h data sub1h,2
28 62CA 0002
29 62CC 322B text '2+'
30 62CE 839A plus2 data _plus2 ; code is in high-speed ram.
31 ; see 1-15-Initialise.a99
32 ;]
33
34 ;[ CELL+ w1 -- w2+2
35 ; adds two (the cell size) to top of stack
36 62D0 62C8 cellph data plus2h,5
36 62D2 0005
37 62D4 4345 text 'CELL+ '
37 62D6 4C4C
37 62D8 2B20
38 62DA 839A cellp data _plus2
39 ;]
40
41 ;[ CHAR+ w1 -- w2+2
42 ; adds two (the cell size) to top of stack
43 62DC 62D0 charph data cellph,5
43 62DE 0005
44 62E0 4348 text 'CHAR+ '
44 62E2 4152
44 62E4 2B20
45 62E6 8396 charp data _plus1
46 ;]
47
48 ;[ 2- w1 -- w2 79 "two-minus"
49 ; w2 is the result of subtracting two from w1 according to the operation of -
50 62E8 62DC sub2h data charph,2
50 62EA 0002
51 62EC 322D text '2-'
52 62EE 839E sub2 data _sub2 ; code is in high-speed ram.
53 ; see 1-15-Initialise.a99
54 ;]
55
56 ;[ 2* ( x -- x<<1 )
57 ; shifts the value on the stack left by one bit.
58 62F0 62E8 mul2h data sub2h,2
58 62F2 0002
59 62F4 322A text '2*'
60 62F6 62F8 mul2 data $+2
61 62F8 A514 mul3 a *stack,*stack ; :-)
62 62FA 045C b *next
63 ;]
64
65 ;[ CELLS ( x1 -- x1*2 )
66 ; returns the memory size required to hold x1 cells
67 62FC 62F0 cellsh data mul2h,5
67 62FE 0005
68 6300 4345 text 'CELLS '
68 6302 4C4C
68 6304 5320
69 6306 62F8 cells data mul3 ; use the word 2* to do our work for us
70 ;]
71
72 ;[ 2/ n1 -- n2 83 "two-divide"
73 ; n2 is the result of arithmetically shifting n1 right one bit.
74 ; The sign is included in the shift and remains unchanged.
75 6308 62FC div2h data cellsh,2
75 630A 0002
76 630C 322F text '2/'
77 630E 6310 div2 data $+2
78 6310 C214 mov *stack,r8 ; TOS in r8
79 6312 0818 sra r8,1 ; shift right
80 6314 C508 mov r8,*stack ; store on stack
81 6316 045C b *next
82 ;]
83
84 ;[ + w1 w2 -- w3 79 "plus"
85 ; w3 is the arithmetic sum of w1 plus w2.
86 6318 6308 addh data div2h,1
86 631A 0001
87 631C 2B20 text '+ '
88 631E 83A2 add data _add ; code is in high-speed ram.
89 ; see 1-15-Initialise.a99
90 ;]
91
92 ;[ - w1 w2 -- w3 79 "minus"
93 ; w3 is the result of subtracting w2 from w1.
94 6320 6318 subh data addh,1
94 6322 0001
95 6324 2D20 text '- '
96 6326 83A6 sub data _sub ; code is in high-speed ram.
97 ; see 1-15-Initialise.a99
98 ;]
99
100 ;[ * w1 w2 -- w3 79 "times"
101 ; w3 is the least-significant 16 bits of the arithmetic product of w1 times w2.
102 6328 6320 mulh data subh,1
102 632A 0001
103 632C 2A20 text '* '
104 632E 83AA mul data _mul ; code is in high-speed ram.
105 ; see 1-15-Initialise.a99
106 ;]
107
108 ;[ */ n1 n2 n3 -- n4 83 "times-divide"
109 ; n1 is first multiplied by n2 producing an intermediate 32-bit result.
110 ; n4 is the floor of the quotient of the intermediate 32-bit result divided by
111 ; the divisor n3.
112 ; The product of n1 times n2 is maintained as an intermediate 32-bit result for
113 ; greater precision than the otherwise equivalent sequence: n1 n2 * n3 / .
114 ; An error condition results if the divisor is zero or if the quotient falls
115 ; outside of the range {-32,768..32,767}.
116 6330 6328 sslash data mulh,2
116 6332 0002
117 6334 2A2F text '*/'
118 6336 8320 data docol
119 6338 6386 data ssm ; */MOD
120 633A 61D2 data nip ; discard remainder
121 633C 832C data exit
122 633E 045C b *next
123 ;]
124
125 ;[ UM* u1 u2 -- ud 83 "u-m-times"
126 ; ud is the unsigned-double product of u1 times u2.
127 ; All values and arithmetic are unsigned.
128 ; high word of ud to top of stack
129 6340 6330 umsh data sslash,3
129 6342 0003
130 6344 554D text 'UM* '
130 6346 2A20
131 6348 634A data $+2
132 634A C014 mov *stack,r0 ; get u2
133 634C C064 mov @2(stack),r1 ; get r1
133 634E 0002
134 6350 3840 mpy r0,r1 ; perform unsigned multiply
135 6352 C501 mov r1,*stack ; push high word
136 6354 C902 mov r2,@2(stack) ; push low word
136 6356 0002
137 6358 045C b *next
138 ;]
139
140 ;[ /MOD n1 n2 -- n3 n4 83 "divide-mod"
141 ; n3 is the remainder and n4 the floor of the quotient of n1 divided by the
142 ; divisor n2.
143 ; n3 has the same sign as n2 or is zero.
144 ; An error condition results if the divisor is zero or if the quotient falls
145 ; outside of the range {-32,768..32,767}.
146 635A 6340 smodh data umsh,4
146 635C 0004
147 635E 2F4D text '/MOD'
147 6360 4F44
148 6362 6364 smod data $+2
149 6364 C014 mov *stack,r0 ; get n2 (divisor)
150 6366 0701 seto r1 ; dividend is 32-bit, assume negative
151 6368 C0A4 mov @2(stack),r2 ; get n1 (dividend)
151 636A 0002
152 636C 1101 jlt smod1 ; if negative then skip
153 636E 04C1 clr r1 ; otherwise it's positive. clear upper word
154 6370 06A0 smod1 bl @sidiv ; do a signed division
154 6372 6422
155 6374 C501 mov r1,*stack ; push quotient
156 6376 C902 mov r2,@2(stack) ; push remainder
156 6378 0002
157 637A 045C b *next
158 ;]
159
160 ;[ */MOD n1 n2 n3 -- n4 n5 83 "times-divide-mod"
161 ; n1 is first multiplied by n2 producing an intermediate 32-bit result.
162 ; n4 is the remainder and n5 is the floor of the quotient of the intermediate
163 ; 32-bit result divided by the divisor n3. A 32-bit intermediate product is
164 ; used as for */ . n4 has the same sign as n3 or is zero. An error condition
165 ; results if the divisor is zero or if the quotient falls outside of the range
166 ; {-32,768..32,767}.
167 637C 635A ssmh data smodh,5
167 637E 0005
168 6380 2A2F text '*/MOD '
168 6382 4D4F
168 6384 4420
169 6386 6388 ssm data $+2
170 6388 C024 mov @2(stack),r0 ; get n2
170 638A 0002
171 638C C064 mov @4(stack),r1 ; get n1
171 638E 0004
172 6390 06A0 bl @simul ; signed multiply
172 6392 645C
173 6394 C034 mov *stack+,r0 ; pop n3 to r0 (divisor)
174 6396 06A0 bl @sidiv ; signed divide
174 6398 6422
175 639A C501 mov r1,*stack ; push quotient
176 639C C902 mov r2,@2(stack) ; push remainder
176 639E 0002
177 63A0 045C b *next
178 ;]
179
180 ;[ UM/MOD ud u1 -- u2 u3 83 "u-m-divide-mod"
181 ; u2 is the remainder and u3 is the floor of the quotient after dividing ud by
182 ; the divisor u1. All values and arithmetic are unsigned. An error condition
183 ; results if the divisor is zero or if the quotient lies outside the range
184 63A2 637C umodh data ssmh,6
184 63A4 0006
185 63A6 554D text 'UM/MOD'
185 63A8 2F4D
185 63AA 4F44
186 63AC 63AE usmod data $+2
187 63AE C034 mov *stack+,r0 ; pop u1 to r0 (divisor)
188 63B0 C054 mov *stack,r1 ; high word of ud to r1
189 63B2 C0A4 mov @2(stack),r2 ; low word of ud to r2
189 63B4 0002
190 63B6 3C40 div r0,r1 ; perform unsigned division
191 63B8 C501 mov r1,*stack ; push quotient
192 63BA C902 mov r2,@2(stack) ; push remainder
192 63BC 0002
193 63BE 045C b *next
194 ;]
195
196 ;[ / n1 n2 -- n3 83 "divide"
197 ; n3 is the floor of the quotient of n1 divided by the divisor n2.
198 ; An error condition results if the divisor is zero or if the quotient falls
199 ; outside of the range {-32,768..32,767}.
200 63C0 63A2 sdivh data umodh,1
200 63C2 0001
201 63C4 2F20 text '/ '
202 63C6 8320 sdiv data docol,smod,nip,exit
202 63C8 6362
202 63CA 61D2
202 63CC 832C
203 ;]
204
205 ;[ MOD n1 n2 -- n3 83
206 ; n3 is the remainder after dividing n1 by the divisor n2.
207 ; n3 has the same sign as n2 or is zero.
208 ; An error condition results if the divisor is zero or if the quotient falls
209 ; outside of the range {-32,768..32,767}.
210 63CE 63C0 modh data sdivh,3
210 63D0 0003
211 63D2 4D4F text 'MOD '
211 63D4 4420
212 63D6 8320 mod data docol,smod,drop,exit
212 63D8 6362
212 63DA 6172
212 63DC 832C
213 ;]
214
215 ;[ NEGATE n1 -- n2 79
216 ; n2 is the two's complement of n1, i.e, the difference of zero less n1.
217 63DE 63CE negh data modh,6
217 63E0 0006
218 63E2 4E45 text 'NEGATE'
218 63E4 4741
218 63E6 5445
219 63E8 63EA neg_ data $+2
220 63EA 0514 neg2 neg *stack ; negate the word on TOS
221 63EC 045C b *next
222 ;]
223
224 ;[ ABS n -- u 79 "absolute"
225 ; u is the absolute value of n. If n is -32,768 then u is the same value.
226 ; STATUS: TESTED OK 13 APR 2009
227 63EE 63DE absh data negh,3
227 63F0 0003
228 63F2 4142 text 'ABS '
228 63F4 5320
229 63F6 63F8 abs_ data $+2
230 63F8 0754 abs *stack ; compute abs of the word on TOS
231 63FA 045C b *next
232 ;]
233
234 ;[ MIN n1 n2 -- n3 79 "min"
235 ; n3 is the lesser of n1 and n2 according to the operation of < .
236 63FC 63EE minh data absh,3
236 63FE 0003
237 6400 4D49 text 'MIN '
237 6402 4E20
238 6404 6406 min data $+2
239 6406 8534 c *stack+,*stack ; compare n2 and n1 (and pop n2)
240 6408 1101 jlt keepn2 ; keep n2 if it's lower
241 640A 045C b *next ; otherwise keep n1
242 640C C524 keepn2 mov @-2(stack),*stack ; keep n2
242 640E FFFE
243 6410 045C b *next
244 ;]
245
246 ;[ MAX n1 n2 -- n3 79 "max"
247 ; n3 is the greater of n1 and n2 according to the operation of > .
248 6412 63FC maxh data minh,3
248 6414 0003
249 6416 4D41 text 'MAX '
249 6418 5820
250 641A 641C max data $+2
251 641C 8534 c *stack+,*stack ; compare n2 and n1 (and pop n2)
252 641E 15F6 jgt keepn2 ; keep n2 if it's higher
253 6420 045C b *next ; otherwise keep n1
254 ;]
255
256
257 ; Floored math subroutines:
258
259 ;[ Signed divide using Floored Integer Division
260 ; Divides a 32 bit value in r1 and r2 by a 16 bit value in r0
261 ; Inputs:
262 ; r0=divisor
263 ; r1=upper 16 bits dividend
264 ; r2=lower 16 bits dividend
265 ; Outputs:
266 ; r1=16-bit quotient
267 ; r2=16-bit remainder
268 sidiv ; set flags to reflect signs of operands, and force operands positive...
269 6422 04CE clr r14 ; sign of divisor (-1=negative sign)
270 6424 04CF clr r15 ; sign of dividend (-1=negative sign)
271 6426 0740 abs r0 ; force divisor positive
272 6428 1501 jgt sdiv1 ; if positive then jump
273 642A 070E seto r14 ; flag negative divisor
274 642C C041 sdiv1 mov r1,r1 ; check sign of dividend
275 642E 1304 jeq sdiv2
276 6430 1503 jgt sdiv2 ; if positive then jump
277 6432 0541 inv r1 ; otherwise negate the dividend
278 6434 0502 neg r2 ;
279 6436 070F seto r15 ; and flag dividend as negative
280 ; perform division...
281 6438 C202 sdiv2 mov r2,r8 ; store a copy of the dividend
282 643A 3C40 div r0,r1 ; perform the division. r1=quot, r2=rem
283 ; check if floor should be applied... (signs different and remainder<>0)
284 643C 83CE sdiv3 c r14,r15 ; compare signs of dividend and divisor
285 643E 1309 jeq signdo ; if same then jump
286 6440 0501 neg r1 ; negate quotient
287 6442 C082 mov r2,r2 ; check remainder
288 6444 1306 jeq signdo ; jump if no remainder
289 ; apply floor rule...
290 6446 0601 floor dec r1 ; floor the quotient
291 ; compute remainder remainder=(divisor*quotient)-dividend
292 6448 C241 mov r1,r9 ; get floored quotient
293 644A 0749 abs r9 ; force positive
294 644C 3A40 mpy r0,r9 ; divisor*quotient (result in r10)
295 644E 6288 s r8,r10 ; subtract dividend
296 6450 C08A mov r10,r2 ; overwrite original remainder
297 ; apply sign of divisor to remainder
298 6452 C38E signdo mov r14,r14 ; check sign of divisor
299 6454 1101 jlt floor1 ; if negative then jump
300 6456 045B rt ; otherwise we're done
301 6458 0502 floor1 neg r2 ; remainder takes sign of divisor
302 645A 045B rt ; done
303 ;]
304
305 ;[ Signed Multiply
306 ; multiplies two signed 16-bit values, n1 & n2, giving a signed 32-bit product
307 ; Inputs:
308 ; r0=n1
309 ; r1=n2
310 ; Outputs:
311 ; r1=product, upper 16-bits
312 ; r2=product, lower 16-bits
313 ; check if signs of inputs are different
314 645C C180 simul mov r0,r6 ; copy n1
315 645E 2981 xor r1,r6 ; check signs (r6=negative if signs differ)
316 6460 0740 abs r0 ; force positive
317 6462 0741 abs r1 ; force positive
318 6464 3840 mpy r0,r1 ; n1*n2 (product in r1 & r2)
319 ; if input signs were different then negate results
320 6466 C186 mov r6,r6 ; check signs flag
321 6468 1504 jgt simul1 ; if same then leave positive
322 646A 0541 inv r1 ; invert high word
323 646C 0502 neg r2 ; negate low word
324 646E 1701 jnc simul1 ; skip if no carry
325 6470 0581 inc r1 ; add 1 to high word to compensate for carry
326 6472 045B simul1 rt
327 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-04-Comparison.a99'
*
1 ; _____ _
2 ; / ____| (_)
3 ; | | ___ _ __ ___ _ __ __ _ _ __ _ ___ ___ _ __
4 ; | | / _ \| '_ ` _ \| '_ \ / _` | '__| / __|/ _ \| '_ \
5 ; | |____| (_) | | | | | | |_) | (_| | | | \__ \ (_) | | | |
6 ; \_____|\___/|_| |_| |_| .__/ \__,_|_| |_|___/\___/|_| |_|
7 ; | |
8 ; |_|
9 ; __ __ _
10 ; \ \ / / | |
11 ; \ \ /\ / /___ _ __ __| |___
12 ; \ \/ \/ // _ \| '__/ _` / __|
13 ; \ /\ /| (_) | | | (_| \__ \
14 ; \/ \/ \___/|_| \__,_|___/
15
16 ;[ = n1 n2 -- flag 83 "equals"
17 ; flag is true if n1 is equal to n2.
18 6474 6412 eqh data maxh,1
18 6476 0001
19 6478 3D20 text '= '
20 647A 647C eq data $+2
21 647C 8534 c *stack+,*stack ; compare and pop n2
22 647E 1369 jeq sTrue ; set true if n1=n2
23 6480 106A jmp sFalse ; else set result to false
24 ;]
25
26 ;[ > n1 n2 -- flag 83 "greater-than"
27 ; flag is true if n1 is greater than n2.
28 ; -32768 32767 > must return false.
29 ; -32768 0 > must return false.
30 6482 6474 gth data eqh,1
30 6484 0001
31 6486 3E20 text '> '
32 6488 648A gt data $+2
33 648A 8534 c *stack+,*stack ; compare n2 to n1. pop n2
34 648C 1162 jlt sTrue ; set true if n2
35 648E 1063 jmp sFalse ; else set result to false
36 ;]
37
38 ;[ < n1 n2 -- flag 83 "less-than"
39 ; flag is true if n1 is less than n2.
40 ; -32678 32767 < must return true.
41 ; -32768 0 < must return true.
42 6490 6482 lth data gth,1
42 6492 0001
43 6494 3C20 text '< '
44 6496 6498 lt data $+2
45 6498 8534 c *stack+,*stack ; compare n2 to n1. pop n2
46 649A 155B jgt sTrue ; set true if n2>n1
47 649C 105C jmp sFalse ; else set result to false
48 ;]
49
50 ;[ >= n1 n2 -- flag
51 ; returns true if n1>=n2
52 649E 6490 gteh data lth,2
52 64A0 0002
53 64A2 3E3D text '>='
54 64A4 64A6 gte data $+2
55 64A6 8534 c *stack+,*stack ; compare n2 to n2. pop n2
56 64A8 1154 jlt sTrue ; set true if n2
57 64AA 1353 jeq sTrue ; or if n2=n1
58 64AC 1054 jmp sFalse ; else set result to false
59 ;]
60
61 ;[ <= (SIGNED) ( n1 n2 -- flag )
62 ; returns true if n1<=n2
63 64AE 649E lteh data gteh,2
63 64B0 0002
64 64B2 3C3D text '<='
65 64B4 64B6 lte data $+2
66 64B6 8534 c *stack+,*stack ; compare n2 to n1. pop n2
67 64B8 154C jgt sTrue ; set true if n2>n1
68 64BA 134B jeq sTrue ; or if n2=n1
69 64BC 104C jmp sFalse ; else set result to false
70 ;]
71
72 ;[ <> ( n1 n2 -- flag )
73 ; returns true if n1!=n2
74 64BE 64AE neqhh data lteh,2
74 64C0 0002
75 64C2 3C3E text '<>'
76 64C4 64C6 neq data $+2
77 64C6 8534 c *stack+,*stack ; compare n2 to n1. pop n2
78 64C8 1644 jne sTrue ; set true if n2<>n1
79 64CA 1045 jmp sFalse ; else set result to false
80 ;]
81
82 ;[ 0= w -- flag 83 "zero-equals"
83 ; flag is true if w is zero.
84 64CC 64BE eqzh data neqhh,2
84 64CE 0002
85 64D0 303D text '0='
86 64D2 64D4 eqz data $+2
87 64D4 C514 mov *stack,*stack ; compare to tos to 0
88 64D6 133D jeq sTrue ; set true if tos=0
89 64D8 103E jmp sFalse ; else set result to false
90 ;]
91
92 ;[ 0<> ( x -- flag )
93 ; returns true if x!=0
94 64DA 64CC neqzh data eqzh,3
94 64DC 0003
95 64DE 303C text '0<> '
95 64E0 3E20
96 64E2 64E4 neqz data $+2
97 64E4 C514 mov *stack,*stack ; compare tos to 0
98 64E6 1635 jne sTrue ; set true if tos<>0
99 64E8 1036 jmp sFalse ; else set result to false
100 ;]
101
102 ;[ 0< n -- flag 83 "zero-less"
103 ; flag is true if n is less than zero (negative).
104 64EA 64DA ltzh data neqzh,2
104 64EC 0002
105 64EE 303C text '0<'
106 64F0 64F2 ltz data $+2
107 64F2 C514 mov *stack,*stack ; compare tos to 0
108 64F4 112E jlt sTrue ; set true if tos<0
109 64F6 102F jmp sFalse ; else set result to false
110 ;]
111
112 ;[ 0> n -- flag 83 "zero-greater"
113 ; flag is true if n is greater than zero.
114 64F8 64EA gtzh data ltzh,2
114 64FA 0002
115 64FC 303E text '0>'
116 64FE 6500 gtz data $+2
117 6500 C514 mov *stack,*stack ; compare tos to 0
118 6502 1527 jgt sTrue ; set true if tos>0
119 6504 1028 jmp sFalse ; else set result to false
120 ;]
121
122 ;[ U< u1 u2 -- flag 83 "u-less-than"
123 ; flag is true if u1 is less than u2.
124 6506 64F8 ulessh data gtzh,2
124 6508 0002
125 650A 553C text 'U<'
126 650C 650E uless data $+2
127 650E 8534 c *stack+,*stack ; compare u2 to u1. pop u2
128 6510 1B20 jh sTrue ; set true if u2>u1
129 6512 1021 jmp sFalse ; else set false
130 ;]
131
132 ;[ WITHIN ( n low high -- true|false )
133 ; returns true if n is within low and high+1
134 6514 6506 withh data ulessh,6
134 6516 0006
135 6518 5749 text 'WITHIN'
135 651A 5448
135 651C 494E
136 651E 8320 within data docol,over,sub,rspush,sub,rspop,uless,exit
136 6520 61C8
136 6522 6326
136 6524 6290
136 6526 6326
136 6528 62AC
136 652A 650C
136 652C 832C
137 ;]
138
139 ;[ 0<= ( x -- flag )
140 ; returns true if x<=0
141 652E 6514 ltezh data withh,3
141 6530 0003
142 6532 303C text '0<= '
142 6534 3D20
143 6536 6538 ltez data $+2
144 6538 C514 mov *stack,*stack ; compare tos to 0
145 653A 110B jlt sTrue ; set true if tos<0
146 653C 130A jeq sTrue ; or if tos=0
147 653E 100B jmp sFalse ; else set result to false
148 ;]
149
150 ;[ 0>= ( x -- flag )
151 ; returns true if x>=0
152 6540 652E gtezh data ltezh,3
152 6542 0003
153 6544 303E text '0>= '
153 6546 3D20
154 6548 654A gtez data $+2
155 654A C514 mov *stack,*stack ; compare tos to 0
156 654C 1502 jgt sTrue ; set true if tos>0
157 654E 1301 jeq sTrue ; or if tos=0
158 6550 1002 jmp sFalse ; else set result to false
159 ;]
160
161 ; The following routines are common to all the routines above.
162 ; The first routine returns a true result, the second routine a false result.
163 ; Each routine has two entry points, depending on whether 1 or 2 parameters
164 ; should be removed from the stack.
165
166 ; called when the result of the comparison is true
167 6552 0714 sTrue seto *stack ; set value to -1 (true)
168 6554 045C b *next
169
170 ; called when the result of the comparison is false
171 6556 04D4 sFalse clr *stack ; set result to 0 (false)
172 6558 045C b *next
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-05-FlowControl.a99'
*
1 ; ______ _ _____ _ _
2 ; | ____| | / ____| | | | |
3 ; | |__ | | _____ __ | | ___ _ __ | |_ _ __ ___ | |
4 ; | __| | |/ _ \ \ /\ / / | | / _ \| '_ \| __| '__/ _ \| |
5 ; | | | | (_) \ V V / | |____| (_) | | | | |_| | | (_) | |
6 ; |_| |_|\___/ \_/\_/ \_____|\___/|_| |_|\__|_| \___/|_|
7 ; Flow control words
8
9 ; MARK & AHEAD: Utilities for flow control words
10 ; : MARK ( -- addr) HERE 0 , ;
11 655A 8320 mark data docol
12 655C 780E data ghere,lit0,comma
12 655E 6084
12 6560 70CC
13 6562 832C data exit
14
15 ; : AHEAD ( -- addr ) POSTPONE BRANCH MARK ; IMMEDIATE
16 6564 8320 ahead data docol
17 6566 7262 data compile,branch,mark
17 6568 65E4
17 656A 655A
18 656C 832C data exit
19
20
21 ;[ FOR ( loop_count -- )
22 ; Implements FOR...NEXT looping as in COUNT FOR .. .. NEXT
23 ; I is available for retrieving the index.
24 ; : FOR ( start--) COMPILE LIT 0 , COMPILE SWAP [COMPILE] DO ; IMMEDIATE
25 656E 6540 forh data gtezh,immed+3
25 6570 8003
26 6572 464F text 'FOR '
26 6574 5220
27 6576 8320 for data docol
28 6578 7262 data compile,lit0
28 657A 6084
29 657C 7262 data compile,swap,do1
29 657E 617C
29 6580 66DA
30 6582 832C data exit
31 ;]
32
33 ;[ NEXT
34 ; : NEXT ( --) COMPILE LIT -1 , [COMPILE] +LOOP ; IMMEDIATE
35 6584 656E nexth data forh,immed+4
35 6586 8004
36 6588 4E45 text 'NEXT'
36 658A 5854
37 658C 8320 fnext1 data docol
38 658E 609C data litm1,clc,ploop1
38 6590 60AC
38 6592 675A
39 6594 832C data exit
40 ;]
41
42 ; : IF ( -- addr ) POSTPONE ?BRANCH MARK ; IMMEDIATE
43 ;[ IF flag -- C,I,79
44 ; -- sys (compiling)
45 ; Used in the form:
46 ; flag IF ... ELSE ... THEN
47 ; or flag IF ... THEN
48 ; If flag is true, the words following IF are executed and the words following
49 ; ELSE until just after THEN are skipped. The ELSE part is optional.
50 ; If flag is false, the words from IF through ELSE , or from IF through THEN
51 ; (when no ELSE is used), are skipped.
52 ; sys is balanced with its corresponding ELSE or THEN .
53 ; See: "9.9 Control Structures"
54 6596 6584 ifh data nexth,immed+2
54 6598 8002
55 659A 4946 text 'IF'
56 659C 8320 if data docol
57 659E 70B2 data lit,ifcnt,refup
57 65A0 A07C
57 65A2 67BA
58 65A4 7262 data compile,zbrnch,mark
58 65A6 65F6
58 65A8 655A
59 65AA 832C data exit
60 ;]
61
62 ; : THEN HERE SWAP ! ; IMMEDIATE
63 ;[ THEN -- C,I,79
64 ; sys -- (compiling)
65 ; Used in the form:
66 ; flag IF ... ELSE ... THEN
67 ; or flag IF ... THEN
68 ; THEN is the point where execution continues after ELSE , or IF when no ELSE
69 ; is present.
70 ; sys is balanced with its corresponding IF or ELSE . See: IF ELSE
71 65AC 6596 thenh data ifh,immed+4
71 65AE 8004
72 65B0 5448 text 'THEN'
72 65B2 454E
73 65B4 8320 then data docol
74 65B6 70B2 data lit,ifcnt,refdn
74 65B8 A07C
74 65BA 67C2
75 65BC 780E data ghere,swap,store
75 65BE 617C
75 65C0 6852
76 65C2 832C data exit
77 ;]
78
79 ; : ELSE POSTPONE AHEAD SWAP POSTPONE THEN ; IMMEDIATE
80 ;[ ELSE -- C,I,79
81 ; sys1 -- sys2 (compiling)
82 ; Used in the form:
83 ; flag IF ... ELSE ... THEN
84 ; ELSE executes after the true part following IF . ELSE forces execution to
85 ; continue at just after THEN . sys1 is balanced with its corresponding IF .
86 ; sys2 is balanced with its corresponding THEN . See: IF THEN
87 65C4 65AC elseh data thenh,immed+4
87 65C6 8004
88 65C8 454C text 'ELSE'
88 65CA 5345
89 65CC 8320 else data docol
90 65CE 6564 data ahead,swap,ghere,swap,store
90 65D0 617C
90 65D2 780E
90 65D4 617C
90 65D6 6852
91 65D8 832C data exit
92 ;]
93
94 ;[ BRANCH ( -- )
95 ; unconditional branch: e.g: BRANCH 4 will branch forwards four words.
96 ; Negative offsets supported.
97 65DA 65C4 brnchh data elseh,6
97 65DC 0006
98 65DE 4252 text 'BRANCH'
98 65E0 414E
98 65E2 4348
99 65E4 65E6 branch data $+2
100 ; at entry, R3 is pointing at the branch address...
101 65E6 C0D3 mov *pc,pc ; get the in-line address and move to the
102 65E8 045C b *next ; instruction pointer
103
104 ;]
105
106 ;[ 0BRANCH ( flag -- )
107 ; Branch if data on the stack is 0. e.g: 0BRANCH 4 will branch forwards 4
108 ; bytes if the value on the data stack is 0
109 65EA 65DA zbrchh data brnchh,7
109 65EC 0007
110 65EE 3042 text '0BRANCH '
110 65F0 5241
110 65F2 4E43
110 65F4 4820
111 65F6 83B4 zbrnch data _zbrnch ; code is in high-speed ram.
112 ; see 1-15-Initialise.a99
113 ;]
114
115 ;[ CASE..OF..ENDCASE ( -- )
116 ; Part of CASE..OF..ENDCASE
117 ; CASE
118 65F8 65EA caseh data zbrchh,immed+4
118 65FA 8004
119 65FC 4341 text 'CASE'
119 65FE 5345
120 6600 8320 case data docol
121 6602 70B2 data lit,cascnt,refup ; reference count
121 6604 A082
121 6606 67BA
122 6608 6084 data lit0
123 660A 832C data exit
124
125 ; OF
126 660C 65F8 ofh data caseh,immed+2
126 660E 8002
127 6610 4F46 text 'OF'
128 6612 8320 of data docol
129 6614 70B2 data lit,ofcnt,refup
129 6616 A084
129 6618 67BA
130 661A 7262 data compile,over,compile,eq,if,compile,drop
130 661C 61C8
130 661E 7262
130 6620 647A
130 6622 659C
130 6624 7262
130 6626 6172
131 6628 832C data exit
132
133 ; ENDOF
134 662A 660C endofh data ofh,immed+5
134 662C 8005
135 662E 454E text 'ENDOF '
135 6630 444F
135 6632 4620
136 6634 8320 endof data docol
137 6636 70B2 data lit,ofcnt,refdn,else
137 6638 A084
137 663A 67C2
137 663C 65CC
138 663E 832C data exit
139
140 ; ENDCASE
141 6640 662A endcah data endofh,immed+7
141 6642 8007
142 6644 454E text 'ENDCASE '
142 6646 4443
142 6648 4153
142 664A 4520
143 664C 8320 endcas data docol
144 664E 70B2 data lit,cascnt,refdn ; reference count
144 6650 A082
144 6652 67C2
145 6654 7262 data compile,drop,qdup,zbrnch,$+8,then,branch,$-10
145 6656 6172
145 6658 61FC
145 665A 65F6
145 665C 6664
145 665E 65B4
145 6660 65E4
145 6662 6658
146 6664 832C data exit
147 ;]
148
149 ; : BEGIN HERE ; IMMEDIATE \ synonym purely for readability
150 ;[ BEGIN -- C,I,79
151 ; -- sys (compiling)
152 ; Used in the form:
153 ; BEGIN ... flag UNTIL
154 ; or BEGIN ... flag WHILE ... REPEAT
155 ; BEGIN marks the start of a word sequence for repetitive execution.
156 ; A BEGIN-UNTIL loop will be repeated until flag is true.
157 ; A BEGIN-WHILE-REPEAT will be repeated until flag is false.
158 ; The words after UNTIL or REPEAT will be executed when either loop is finished.
159 ; sys is balanced with its corresponding UNTIL or WHILE .
160 ; See: "9.9 Control Structures"
161 6666 6640 beginh data endcah,immed+5
161 6668 8005
162 666A 4245 text 'BEGIN '
162 666C 4749
162 666E 4E20
163 6670 8320 begin data docol
164 6672 70B2 data lit,begcnt,refup
164 6674 A086
164 6676 67BA
165 6678 780E data ghere
166 667A 832C data exit
167 ;]
168
169 ; : UNTIL POSTPONE ?BRANCH , ; IMMEDIATE
170 ;[ UNTIL ( address -- )
171 667C 6666 untilh data beginh,immed+5
171 667E 8005
172 6680 554E text 'UNTIL '
172 6682 5449
172 6684 4C20
173 6686 8320 until data docol
174 6688 70B2 data lit,begcnt,refdn
174 668A A086
174 668C 67C2
175 668E 7262 data compile,zbrnch,comma
175 6690 65F6
175 6692 70CC
176 6694 832C data exit
177 ;]
178
179 ; : AGAIN POSTPONE BRANCH , ; IMMEDIATE
180 ;[ AGAIN ( address -- )
181 6696 667C againh data untilh,immed+5
181 6698 8005
182 669A 4147 text 'AGAIN '
182 669C 4149
182 669E 4E20
183 66A0 8320 again data docol
184 66A2 70B2 data lit,begcnt,refdn
184 66A4 A086
184 66A6 67C2
185 66A8 7262 data compile,branch,comma
185 66AA 65E4
185 66AC 70CC
186 66AE 832C data exit
187 ;]
188
189 ; : WHILE POSTPONE IF SWAP ; IMMEDIATE
190 ;[ WHILE flag -- C,I,79
191 ; sys1 -- sys2 (compiling)
192 ; Used in the form:
193 ; BEGIN ... flag WHILE ... REPEAT
194 ; Selects conditional execution based on flag. When flag is true, execution
195 ; continues to just after the WHILE through to the REPEAT which then continues
196 ; execution back to just after the BEGIN.
197 ; When flag is false, execution continues to just after the REPEAT, exiting the
198 ; control structure.
199 ; sys1 is balanced with its corresponding BEGIN.
200 ; sys2 is balanced with its corresponding REPEAT. See: BEGIN
201 66B0 6696 whileh data againh,immed+5
201 66B2 8005
202 66B4 5748 text 'WHILE '
202 66B6 494C
202 66B8 4520
203 66BA 8320 while data docol
204 66BC 659C data if,swap
204 66BE 617C
205 66C0 832C data exit
206 ;]
207
208 ; : REPEAT POSTPONE AGAIN POSTPONE THEN ; IMMEDIATE
209 ;[ REPEAT -- C,I,79
210 ; sys -- (compiling)
211 ; Used in the form:
212 ; BEGIN ... flag WHILE ... REPEAT
213 ; At execution time, REPEAT continues execution to just after the corresponding
214 ; BEGIN.
215 ; sys is balanced with its corresponding WHILE. See: BEGIN
216 66C2 66B0 repeth data whileh,immed+6
216 66C4 8006
217 66C6 5245 text 'REPEAT'
217 66C8 5045
217 66CA 4154
218 66CC 8320 repeat data docol
219 66CE 66A0 data again,then
219 66D0 65B4
220 66D2 832C data exit
221 ;]
222
223 ;[ DO w1 w2 -- C,I,83
224 ; -- sys (compiling)
225 ; Used in the form:
226 ; DO ... LOOP
227 ; or DO ... +LOOP
228 ; Begins a loop which terminates based on control parameters.
229 ; The loop index begins at w2, and terminates based on the limit w1.
230 ; See LOOP and +LOOP for details on how the loop is terminated.
231 ; The loop is always executed at least once.
232 ; For example: w DUP DO ... LOOP executes 65,536 times.
233 ; sys is balanced with its corresponding LOOP or +LOOP .
234 ; See: "9.9 Control Structures"
235 ; note: DO is immediate and compiles a reference to (DO)
236 ;
237 ; Loop frame format:
238 ; 0 = current loop index <----- RSTACK points to this value
239 ; +2 = loop limit
240 ; +4 = loop exit address
241 ; To drop a loop frame, add 6 to RSTACK
242 ;
243 ; In words, for A B DO ... LOOP
244 ; (DO) puts three things on to the return stack
245 ; 1. the address of the word after LOOP - where execution continues when
246 ; the loop executes
247 ; 2. A + >8000 (A with its sign bit 'permuted')
248 ; 3. B minus the value computed at step 2 <-- top of return stack
249 ;
250 ; LOOP and +LOOP add 1 or whatever to the value at 3.
251 ; If the overflow flag is set, drop two elements from the return stack,
252 ; pop the final value from R (the address at 1. above)
253 ; into I and execute next.
254 ;
255 ; I becomes:
256 ; 4. Move the value at 2. above to the data stack
257 ; 5. Add the value at 3. above to the data stack
258 ;
259 66D4 66C2 do1h data repeth,immed+2
259 66D6 8002
260 66D8 444F text 'DO'
261 66DA 8320 do1 data docol
262 66DC 70B2 data lit,docnt,refup ; increase reference counters
262 66DE A07E
262 66E0 67BA
263 66E2 7262 data compile,do,ghere,lit0,comma ; compile (do) here 0 ,
263 66E4 66F6
263 66E6 780E
263 66E8 6084
263 66EA 70CC
264 66EC 832C data exit
265
266 66EE 66D4 doh data do1h,4
266 66F0 0004
267 66F2 2844 text '(DO)'
267 66F4 4F29
268 66F6 66F8 do data $+2
269 66F8 C034 mov *stack+,r0 ; pop initial index
270 66FA C074 mov *stack+,r1 ; pop loop termination value
271 66FC 0221 ai r1,>8000 ; flip sign bit
271 66FE 8000
272 6700 6001 s r1,r0 ; calculate initial index
273 6702 0645 dect rstack ; new return stack entry
274 6704 C573 mov *pc+,*rstack ; loop exit address to return stack
275 6706 0645 dect rstack ; new return stack entry
276 6708 C541 mov r1,*rstack ; loop limit to return stack
277 670A 0645 dect rstack ; new return stack entry
278 670C C540 mov r0,*rstack ; loop index to return stack
279 670E 045C b *next
280 ;]
281
282 ;[ LOOP -- C,I,83
283 ; sys -- (compiling)
284 ; Increments the DO-LOOP index by one. If the new index was incremented across
285 ; the boundary between limit-1 and limit the loop is terminated and loop control
286 ; parameters are discarded. When the loop is not terminated, execution
287 ; continues to just after the corresponding DO.
288 ; sys is balanced with its corresponding DO . See: DO
289 ; note: LOOP is immediate and compiles a reference to (LOOP)
290 6710 66EE loop1h data doh,immed+4
290 6712 8004
291 6714 4C4F text 'LOOP'
291 6716 4F50
292 6718 8320 loop1 data docol
293 671A 70B2 data lit,docnt,refdn ; reduce DO/LOOP reference counters
293 671C A07E
293 671E 67C2
294 6720 6186 data dup,compile,loop
294 6722 7262
294 6724 673E
295 6726 780E loop2 data ghere,plus2,swap,store,plus2,comma
295 6728 62CE
295 672A 617C
295 672C 6852
295 672E 62CE
295 6730 70CC
296 6732 832C data exit
297
298 6734 6710 looph data loop1h,6
298 6736 0006
299 6738 284C text '(LOOP)'
299 673A 4F4F
299 673C 5029
300 673E 6740 loop data $+2
301 6740 0595 inc *rstack ; increment loop count
302 6742 1904 loopchk jno lagain ; if no overflow then loop again
303 6744 0225 loopx ai rstack,6 ; otherwise pop loop frame
303 6746 0006
304 6748 05C3 inct pc ; move past (LOOP)'s in-line parameter
305 674A 045C b *next
306 674C C0D3 lagain mov *pc,pc ; reload loop address
307 674E 045C b *next
308 ;]
309
310 ;[ +LOOP n -- C,I,83 "plus-loop"
311 ; sys -- (compiling)
312 ; n is added to the loop index. If the new index was incremented across the
313 ; boundary between limit-1 and limit then the loop is terminated and loop
314 ; control parameters are discarded. When the loop is not terminated, execution
315 ; continues to just after the corresponding DO.
316 ; sys is balanced with its corresponding DO. See: DO
317 ; note: +LOOP is immediate and compiles a reference to (+LOOP)
318 6750 6734 plooh1 data looph,immed+5
318 6752 8005
319 6754 2B4C text '+LOOP '
319 6756 4F4F
319 6758 5020
320 675A 8320 ploop1 data docol
321 675C 70B2 data lit,docnt,refdn
321 675E A07E
321 6760 67C2
322 6762 6186 data dup,compile,ploop,branch,loop2 ; compile (+LOOP) then as (LOOP)
322 6764 7262
322 6766 6778
322 6768 65E4
322 676A 6726
323
324 676C 6750 plooph data plooh1,7
324 676E 0007
325 6770 282B text '(+LOOP) '
325 6772 4C4F
325 6774 4F50
325 6776 2920
326 6778 677A ploop data $+2
327 677A A574 a *stack+,*rstack ; pop increment and add to index on return stack
328 677C 10E2 jmp loopchk
329 ;]
330
331 ;[ LEAVE -- C,I,83
332 ; -- (compiling)
333 ; Transfers execution to just beyond the next LOOP or +LOOP .
334 ; The loop is terminated and loop control parameters are discarded.
335 ; May only be used in the form:
336 ; DO ... LEAVE ... LOOP
337 ; or DO ... LEAVE ... +LOOP
338 ; LEAVE may appear within other control structures which are nested within the
339 ; do-loop structure. More than one LEAVE may appear within a do-loop.
340 ; See: "9.3 Return Stack"
341 ; Note: LEAVE *must* appear within an IF ... THEN block for correct operation.
342 677E 676C leaveh data plooph,5
342 6780 0005
343 6782 4C45 text 'LEAVE '
343 6784 4156
343 6786 4520
344 6788 678A leave data $+2
345 678A C0E5 mov @4(rstack),pc ; load pc with exit address
345 678C 0004
346 678E 0225 ai rstack,6 ; pop loop frame from return stack
346 6790 0006
347 6792 045C b *next
348 ;]
349
350 ;[ I -- w C,79
351 ; w is a copy of the loop index. May only be used in the
352 ; form:
353 ; DO ... I ... LOOP
354 ; or DO ... I ... +LOOP
355 ; or FOR .. I ... NEXT
356 6794 677E getih data leaveh,1
356 6796 0001
357 6798 4920 text 'I '
358 679A 679C geti data $+2
359 679C 0644 dect stack ; new data stack entry
360 679E C525 mov @2(rstack),*stack ; place index on data stack
360 67A0 0002
361 67A2 A515 a *rstack,*stack ; adjust
362 67A4 045C b *next
363 ;]
364
365 ;[ J -- w C,79
366 ; w is a copy of the index of the next outer loop.
367 ; May only be used within a nested DO-LOOP or DO-+LOOP in the form, for example:
368 ; DO ... DO ... J ... LOOP ... +LOOP
369 ; Also active in nested FOR...NEXT loops.
370 67A6 6794 getjh data getih,1
370 67A8 0001
371 67AA 4A20 text 'J '
372 67AC 67AE getj data $+2
373 67AE 0644 dect stack ; new data stack entry
374 67B0 C525 mov @8(rstack),*stack ; place outer loop index on data stack
374 67B2 0008
375 67B4 A525 a @6(rstack),*stack ; adjust
375 67B6 0006
376 67B8 045C b *next
377 ;]
378
379 ;[ utility routines for reference counting
380 67BA 67BC refup data $+2
381 67BC C034 mov *stack+,r0 ; pop address of reference counter
382 67BE 0590 inc *r0 ; increase reference counter
383 67C0 045C b *next
384
385 67C2 67C4 refdn data $+2
386 67C4 C034 mov *stack+,r0 ; pop address of reference of counter
387 67C6 0610 dec *r0 ; decrease reference counter
388 67C8 045C b *next
389 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-06-Logical.a99'
*
1 ; _ _ _ __ __ _
2 ; | | (_) | | \ \ / / | |
3 ; | | ___ __ _ _ ___ __ _| | \ \ /\ / /___ _ __ __| |___
4 ; | | / _ \ / _` | |/ __|/ _` | | \ \/ \/ // _ \| '__/ _` / __|
5 ; | |____| (_) | (_| | | (__| (_| | | \ /\ /| (_) | | | (_| \__ \
6 ; |______|\___/ \__, |_|\___|\__,_|_| \/ \/ \___/|_| \__,_|___/
7 ; __/ |
8 ; |___/
9 ;
10 ;[ AND 16b1 16b2 -- 16b3 79
11 ; 16b3 is the bit-by-bit logical 'and' of 16b1 with 16b2.
12 67CA 67A6 andh data getjh,3
12 67CC 0003
13 67CE 414E text 'AND '
13 67D0 4420
14 67D2 67D4 and data $+2
15 67D4 0554 inv *stack ; invert 16b2 for SZC instruction
16 ; (see ED/AS manual, page 190)
17 67D6 4534 szc *stack+,*stack ; perform AND function and pop 16b2
18 67D8 045C b *next
19 ;]
20
21 ;[ OR 16b1 16b2 -- 16b3 79
22 ; 16b3 is the bit-by-bit inclusive-or of 16b1 with 16b2.
23 67DA 67CA orh data andh,2
23 67DC 0002
24 67DE 4F52 text 'OR'
25 67E0 67E2 or_ data $+2
26 67E2 E534 soc *stack+,*stack ; or 16b2 and 16b1. pop 16b2
27 67E4 045C b *next
28 ;]
29
30 ;[ XOR 16b1 16b2 -- 16b3 79 "x-or"
31 ; 16b3 is the bit-by-bit exclusive-or of 16b1 with 16b2.
32 67E6 67DA xorh data orh,3
32 67E8 0003
33 67EA 584F text 'XOR '
33 67EC 5220
34 67EE 67F0 xor_ data $+2
35 67F0 C234 mov *stack+,r8 ; pop 16b2 in r8
36 67F2 2A14 xor *stack,r8 ; xor 16b1 with 16b2. result in r8
37 67F4 C508 mov r8,*stack ; result to TOS
38 ; (what a total shitter that I can't do a simple XOR *STACK+,*STACK )
39 67F6 045C b *next
40 ;]
41
42 ;[ NOT 16b1 -- 16b2 83
43 ; 16b2 is the one's complement of 16b1.
44 67F8 67E6 invh data xorh,3
44 67FA 0003
45 67FC 4E4F text 'NOT '
45 67FE 5420
46 6800 6802 inv_ data $+2
47 6802 0554 inv *stack ; invert the word on TOS
48 6804 045C b *next
49 ;]
50
51 ;[ << (bitwise) ( x count -- x )
52 ; left shift x count bits (arithmetic shift)
53 6806 67F8 lsfth data invh,2
53 6808 0002
54 680A 3C3C text '<<'
55 680C 680E lsft data $+2
56 680E C034 mov *stack+,r0 ; pop shift count into r0
57 6810 C214 mov *stack,r8 ; x
58 6812 0A08 sla r8,r0 ; shift x by r0 bits
59 6814 C508 mov r8,*stack ; result back onto stack
60 6816 045C b *next
61 ;]
62
63 ;[ >> ( x count -- x )
64 ; right shift x count bits (logical shift)
65 6818 6806 rsfth data lsfth,2
65 681A 0002
66 681C 3E3E text '>>'
67 681E 6820 rsft data $+2
68 6820 C034 mov *stack+,r0 ; pop shift count into r0
69 6822 C214 mov *stack,r8 ; x
70 6824 0908 srl r8,r0 ; shift x by r0 bits
71 6826 C508 mov r8,*stack ; result back onto stack
72 6828 045C b *next
73 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-07-Memory.a99'
*
1 ; __ __
2 ; | \/ | /\
3 ; | \ / | ___ _ __ ___ ___ _ __ _ _ / \ ___ ___ ___ ___ ___
4 ; | |\/| |/ _ \ '_ ` _ \ / _ \| '__| | | | / /\ \ / __|/ __|/ _ | __/ __|
5 ; | | | | __/ | | | | | (_) | | | |_| | / ____ \ (__| (__| __|__ \__ \
6 ; |_| |_|\___|_| |_| |_|\___/|_| \__, | /_/ \_\___|\___|\___|___/___/
7 ; Memory access words __/ |
8 ; |___/
9
10 0000 9C02 grmwa equ >9c02 ; GROM Write Address Register
11 0000 9802 grmra equ >9802 ; GROM Read Address Register
12 0000 9800 grmrd equ >9800 ; GROM Read Data Register
13 0000 9C00 grmwd equ >9c00 ; GROM Write Data Register
14
15 ;[ @ addr -- 16b 79 "fetch"
16 ; 16b is the value at addr.
17 682A 6818 fetchh data rsfth,1
17 682C 0001
18 682E 4020 text '@ '
19 6830 6832 fetch data $+2
20 6832 C214 mov *stack,r8 ; get address
21 6834 C518 mov *r8,*stack ; peek address and put on data stack
22 6836 045C b *next
23 ;]
24
25 ;[ @++ ( addr -- addr+2 value )
26 ; fetches the cell at memory address "address" then increments address
27 ; and leaves it on the stack
28 6838 682A faddph data fetchh,3
28 683A 0003
29 683C 402B text '@++'
29 683E 2B
30 683F 0000 EVEN *>>> Assembler Auto-Generated <<<
31 6840 6842 ftchpp data $+2
32 6842 C214 mov *stack,r8 ; get addr
33 6844 05D4 inct *stack ; advance addr to get addr+2
34 6846 0644 dect stack ; new stack entry
35 6848 C518 mov *r8,*stack ; peek address and value put on data stack
36 684A 045C b *next
37 ;]
38
39 ;[ ! 16b addr -- 79 "store"
40 ; 16b is stored at addr.
41 684C 6838 storeh data faddph,1
41 684E 0001
42 6850 2120 text '! '
43 6852 6854 store data $+2
44 6854 C234 mov *stack+,r8 ; pop addr
45 6856 C634 mov *stack+,*r8 ; pop 16b and write to addr
46 6858 045C b *next
47 ;]
48
49 ;[ +! w1 addr -- 79 "plus-store"
50 ; w1 is added to the w value at addr using the convention for + .
51 ; This sum replaces the original value at addr.
52 685A 684C staddh data storeh,2
52 685C 0002
53 685E 2B21 text '+!'
54 6860 6862 stadd data $+2
55 6862 C234 mov *stack+,r8 ; pop addr
56 6864 A634 a *stack+,*r8 ; pop w1 and add to value at addr
57 6866 045C b *next
58 ;]
59
60 ;[ C@ addr -- 8b 79 "c-fetch"
61 ; 8b is the contents of the byte at addr.
62 6868 685A chrfh data staddh,2
62 686A 0002
63 686C 4340 text 'C@'
64 686E 6870 chrftc data $+2
65 6870 C214 mov *stack,r8 ; address in r8
66 6872 D218 movb *r8,r8 ; peek address and store in msb of r8
67 6874 0988 srl r8,8 ; move to low byte
68 6876 C508 mov r8,*stack ; move msb of r8 onto data stack
69 6878 045C b *next
70 ;]
71
72 ;[ C! 16b addr -- 79 "c-store"
73 ; The least-significant 8 bits of 16b are stored into the byte at addr.
74 687A 6868 stbh data chrfh,2
74 687C 0002
75 687E 4321 text 'C!'
76 6880 6882 stb data $+2
77 6882 C234 mov *stack+,r8 ; pop addr
78 6884 C1F4 mov *stack+,r7 ; pop 16b
79 6886 06C7 swpb r7 ; rotate LOW BYTE into MSB
80 6888 D607 movb r7,*r8 ; move the byte into the address in r8
81 688A 045C b *next
82 ;]
83
84 ;[ 0! ( addr -- )
85 ; store 0 at addr
86 688C 687A stor0h data stbh,2
86 688E 0002
87 6890 3021 text '0!'
88 6892 6894 store0 data $+2
89 6894 C234 mov *stack+,r8 ; pop address
90 6896 04D8 clr *r8 ; zero it
91 6898 045C stor0x b *next
92 ;]
93
94 ;[ CHARS ( x1 -- x1 )
95 ; return the memory size required to hold x2 chars (bytes)
96 ; note: since this word does nothing, it is immediate, to avoid a run-time
97 ; speed penalty
98 689A 688C charsh data stor0h,immed+5
98 689C 8005
99 689E 4348 text 'CHARS '
99 68A0 4152
99 68A2 5320
100 68A4 6898 chars data stor0x ; do nothing, and use the exit in 0! to do it!
101 ; (saves 2 bytes)
102 ;]
103
104 ;[ V@ ( address -- value )
105 ; read vdp address and return BYTE as 16 bit right justified cell
106 68A6 689A vdpfh data charsh,2
106 68A8 0002
107 68AA 5640 text 'V@'
108 68AC 68AE vdpftc data $+2
109 68AE C014 mov *stack,r0 ; vdp address from data stack to r0
110 68B0 06A0 bl @vsbr ; execute VDP single byte read routine
110 68B2 7F60
111 68B4 0981 srl r1,8 ; value move to low byte
112 68B6 C501 mov r1,*stack ; place it on the stack
113 68B8 045C b *next
114 ;]
115
116 ;[ V! ( value addr -- )
117 ; store BYTE value (as 16 bit right justified cell) at VDP address
118 68BA 68A6 vdpwh data vdpfh,2
118 68BC 0002
119 68BE 5621 text 'V!'
120 68C0 68C2 vdpstr data $+2
121 68C2 C034 mov *stack+,r0 ; pop addr
122 68C4 C074 mov *stack+,r1 ; pop value
123 68C6 06C1 swpb r1 ; get lsb of value into msb
124 68C8 06A0 bl @vsbw ; write to vdp
124 68CA 7F9A
125 68CC 045C b *next
126 ;]
127
128 ;[ VDP Write Word ( address value -- )
129 68CE 68BA vdpwwh data vdpwh,3
129 68D0 0003
130 68D2 5632 text 'V2! '
130 68D4 2120
131 68D6 8320 data docol,swap,vdpww,drop,exit
131 68D8 617C
131 68DA 7D58
131 68DC 6172
131 68DE 832C
132 ;]
133
134 ;[ VDP Read Word
135 ; : V2@ ( vdp_address -- word_value)
136 ; DUP V@ >< SWAP 1+ V@ OR ;
137 68E0 68CE vdprwh data vdpwwh,3
137 68E2 0003
138 68E4 5632 text 'V2@ '
138 68E6 4020
139 68E8 8320 vdprw data docol,dup,vdpftc,swpb_,swap,plus1,vdpftc,or_,exit
139 68EA 6186
139 68EC 68AC
139 68EE 6220
139 68F0 617C
139 68F2 62BA
139 68F4 68AC
139 68F6 67E0
139 68F8 832C
140 ;]
141
142 ;[ VMBR ( vdp_address cpu_address byte_count -- )
143 68FA 68E0 vmbrh data vdprwh,4
143 68FC 0004
144 68FE 564D text 'VMBR'
144 6900 4252
145 6902 6904 fvmbr data $+2
146 6904 0206 li r6,vmbr ; address of vdp routine to call
146 6906 7F82
147 6908 1007 jmp vdpm
148 ;]
149
150 ;[ VMBW ( vdp_address cpu_address byte_count -- )
151 690A 68FA vmbwh data vmbrh,4
151 690C 0004
152 690E 564D text 'VMBW'
152 6910 4257
153 6912 6914 fvmbw data $+2
154 6914 0206 li r6,vmbw ; address of vdp routine to call
154 6916 7FC2
155 ; fall down to vdpm routine below...
156 ;]
157
158 ;[ utility routine used by VMBR & VMBW above
159 vdpm
160 6918 C0B4 mov *stack+,r2 ; pop byte count
161 691A C074 mov *stack+,r1 ; pop cpu address
162 691C C034 mov *stack+,r0 ; pop vdp address
163 691E C082 mov r2,r2 ; check for zero byte count
164 6920 1301 jeq vdpx ; if zero then just exit
165 6922 0696 bl *r6 ; execute appropriate routine
166 6924 045C vdpx b *next
167 ;]
168
169 ;[ ; >MAP ( bank address -- )
170 ; If a SAMS card is present, maps memory bank "bank" to address "address"
171 6926 690A samsh data vmbwh,4
171 6928 0004
172 692A 3E4D text '>MAP'
172 692C 4150
173 692E 6930 sams_ data $+2
174 6930 06A0 bl @bank1
174 6932 8332
175 6934 65FE data _sams ; implemented in 1-04-Memory.a99
176 ;]
177
178 ;[ HFREE ( -- free_bytes )
179 ; returns the number of free bytes in upper 24k RAM
180 6936 6926 hfreeh data samsh,5
180 6938 0005
181 693A 4846 text 'HFREE '
181 693C 5245
181 693E 4520
182 6940 8320 hfree data docol,lit,>ffff,ffaih,fetch,sub,plus1,exit
182 6942 70B2
182 6944 FFFF
182 6946 7750
182 6948 6830
182 694A 6326
182 694C 62BA
182 694E 832C
183 ;]
184
185 ;[ LFREE ( -- free_bytes )
186 ; returns the number of free bytes in lower 8k RAM
187 6950 6936 lfreeh data hfreeh,5
187 6952 0005
188 6954 4C46 text 'LFREE '
188 6956 5245
188 6958 4520
189 695A 8320 lfree data docol,lit
189 695C 70B2
190 695E 4000 bit1 data >4000 ; note: also used by VSBW to save 2 bytes
191 ; yes! memory is THAT tight!
192 6960 7766 data ffaml,fetch,sub,exit
192 6962 6830
192 6964 6326
192 6966 832C
193 ;]
194
195 ;[ FILL addr u 8b -- 83
196 ; u bytes of memory beginning at addr are set to 8b.
197 ; No action is taken if u is zero.
198 6968 6950 fillh data lfreeh,4
198 696A 0004
199 696C 4649 text 'FILL'
199 696E 4C4C
200 6970 6972 fill data $+2
201 6972 06A0 bl @bank1
201 6974 8332
202 6976 65AE data _fill ; implemented in 1-04-Memory.a99
203 ;]
204
205 ;[ CMOVE addr1 addr2 u -- 83 "c-move"
206 ; Move u bytes beginning at address addr1 to addr2.
207 ; The byte at addr1 is moved first, proceeding toward high memory.
208 ; If u is zero nothing is moved.
209 6978 6968 cmoveh data fillh,5
209 697A 0005
210 697C 434D text 'CMOVE '
210 697E 4F56
210 6980 4520
211 6982 6984 cmove data $+2
212 6984 06A0 bl @bank1
212 6986 8332
213 6988 65C0 data _cmove ; implemented in 1-04-Memory.a99
214 ;]
215
216 ;[ CMOVE> addr1 addr2 u -- 83 "c-move-up"
217 ; Move the u bytes at address addr1 to addr2.
218 ; The move begins by moving the byte at (addr1 plus u minus 1) to
219 ; (addr2 plus u minus 1) and proceeds to successively lower addresses for u
220 ; bytes.
221 ; If u is zero nothing is moved. Useful for sliding a string towards higher
222 ; addresses.
223 698A 6978 cmovfh data cmoveh,6
223 698C 0006
224 698E 434D text 'CMOVE>'
224 6990 4F56
224 6992 453E
225 6994 6996 cmovf data $+2
226 6996 06A0 bl @bank1
226 6998 8332
227 699A 65D0 data _cmovf ; implemented in 1-04-Memory.a99
228 ;]
229
230 ;[ MEM ( -- )
231 ; Displays the number of free bytes in low memory, high memory, and the total
232 ; number of free bytes to the screen.
233 699C 698A freeh data cmovfh,3
233 699E 0003
234 69A0 4D45 text 'MEM '
234 69A2 4D20
235 69A4 8320 data docol
236 69A6 6940 data hfree,lfree,dup2,udot,udot,add,udot,exit
236 69A8 695A
236 69AA 75EE
236 69AC 782C
236 69AE 782C
236 69B0 631E
236 69B2 782C
236 69B4 832C
237 ;]
238
239 ;[ COPYW (source destination count -- )
240 ; copy WORDS from source to destination for 'count' words
241 ; no action taken if count=0
242 69B6 699C copywh data freeh,5
242 69B8 0005
243 69BA 434F text 'COPYW '
243 69BC 5059
243 69BE 5720
244 69C0 69C2 copyw data $+2
245 69C2 06A0 bl @bank1
245 69C4 8332
246 69C6 65EE data _copyw ; implemented in 1-04-Memory.a99
247 ;]
248
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-08-Parsing.a99'
*
1 ; _____ _ __ __ _
2 ; | __ \ (_) \ \ / / | |
3 ; | |__) |__ _ _ __ ___ _ _ __ __ _ \ \ /\ / /___ _ __ __| |___
4 ; | ___// _` | '__/ __| | '_ \ / _` | \ \/ \/ // _ \| '__/ _` / __|
5 ; | | | (_| | | \__ \ | | | | (_| | \ /\ /| (_) | | | (_| \__ \
6 ; |_| \__,_|_| |___/_|_| |_|\__, | \/ \/ \___/|_| \__,_|___/
7 ; __/ |
8 ; |___/
9 ; Dictionary lookup and associated parsing words
10
11 ;[ EXPECT addr +n -- M,83
12 ; Receive characters and store each into memory. The transfer begins at addr
13 ; proceeding towards higher addresses one byte per character until either a
14 ; "return" is received or until +n characters have been transferred.
15 ; No more than +n characters will be stored.
16 ; The "return" is not stored into memory.
17 ; No characters are received or transferred if +n is zero.
18 ; All characters actually received and stored into memory will be displayed,
19 ; with the "return" displaying as a space. See: SPAN "9.5.2 EXPECT"
20 69C8 69B6 expcth data copywh,6
20 69CA 0006
21 69CC 4558 text 'EXPECT'
21 69CE 5045
21 69D0 4354
22 69D2 69D4 expect data $+2
23 69D4 04E0 clr @in ; clear >IN variable
23 69D6 A042
24 69D8 04CE clr r14 ; counter for number of characters
25 ; *actually* in the buffer
26 69DA C374 mov *stack+,r13 ; pop length in r13
27 69DC C2B4 mov *stack+,r10 ; pop address address in r10
28 69DE C34D mov r13,r13 ; check length
29 69E0 133E jeq zchars ; quit if 0 characters requested
30 69E2 06A0 expnxt bl @kscn ; scan keyboard (wait for a keypress)
30 69E4 6DE2
31 ; ascii code returned on the stack
32 ; check for enter key...
33 69E6 8814 c *stack,@datCR ; compare to carriage return (enter key)
33 69E8 6A64
34 69EA 1337 jeq exp2 ; exit routine if enter was pressed
35 ;[ ; check for backspace key...
36 69EC 8814 c *stack,@lit8+4 ; compare to backspace key
36 69EE 6098
37 69F0 161F jne skipbs ; skip if backspace not pressed
38 69F2 05C4 inct stack ; remove backspace from stack
39 69F4 C38E mov r14,r14 ; check if anything in the buffer
40 69F6 13F5 jeq expnxt ; tib is empty, ignore...
41 ; do backspace...
42 69F8 06A0 bl @ccp ; compute cursor position
42 69FA 6F14
43 69FC 0201 li r1,>2000 ; load a space character
43 69FE 2000
44 6A00 06A0 bl @vsbw ; erase the cursor
44 6A02 7F9A
45 6A04 C020 mov @scrX,r0 ; get current x position
45 6A06 A028
46 6A08 160B jne back1 ; if x>0 we don't need to move up one line
47 6A0A C820 mov @xmax,@scrX ; move to end of line
47 6A0C A02C
47 6A0E A028
48 6A10 0620 dec @scrX ; correct X
48 6A12 A028
49 6A14 0620 dec @scrY ; up one screen line
49 6A16 A02A
50 6A18 C020 mov @scrY,r0 ; check y
50 6A1A A02A
51 6A1C 1106 jlt bumpY ; if <0 then reset to 0
52 6A1E 1002 jmp back2
53 6A20 0620 back1 dec @scrX ; move back one character
53 6A22 A028
54 6A24 060E back2 dec r14 ; decrement buffer index pointer
55 6A26 060A dec r10 ; decrement buffer position
56 6A28 10DC jmp expnxt ; get another keypress
57 6A2A 05A0 bumpY inc @scrY ; prevent Y from going <0
57 6A2C A02A
58 6A2E 10FA jmp back2
59 ;]
60 ; process keypress...
61 6A30 0644 skipbs dect stack ; new stack entry
62 6A32 C524 mov @2(stack),*stack ; duplicate value on stack for EMIT
62 6A34 0002
63 6A36 06A0 bl @emit_ ; call emit (which may/may not call SCRLUP)
63 6A38 6DA0
64 6A3A 06D4 swpb *stack ; shift ascii code into MSB
65 6A3C C074 mov *stack+,r1
66 6A3E C00A mov r10,r0
67 6A40 058A inc r10
68 6A42 06A0 bl @vsbw0
68 6A44 7FA8
69 6A46 058E inc r14 ; increment 'number of characters in buffer so far'
70 ; counter
71 6A48 880E c r14,@tibsiz ; do we have #TIB characters in the buffer?
71 6A4A A04A
72 6A4C 1302 jeq exp1 ; if so, exit the routine
73 6A4E 838D c r13,r14 ; have we got 'length' characters?
74 6A50 16C8 jne expnxt ; read another key if not
75 6A52 C80E exp1 mov r14,@_span ; move character count into _span
75 6A54 A04C
76 6A56 0460 b @space1+2 ; type a space to the console and exit
76 6A58 6D3A
77 6A5A 05C4 exp2 inct stack ; pop ascii 13 off the stack
78 6A5C 10FA jmp exp1
79
80 ; special case if 0 characters were requested for some weird reason...
81 6A5E 04E0 zchars clr @_span
81 6A60 A04C
82 6A62 045C b *next
83 6A64 000D datCR data 13 ; ascii code for carriage return
84 ;]
85
86 ;[ Comments: ( \ & .(
87 ; Allows comments e.g. : 1TO3 ( comment) 1 2 3 ;
88 ; Reads through the TIB until ) is found or end of line
89 6A66 69C8 remh data expcth,immed+1
89 6A68 8001
90 6A6A 2820 text '( '
91 6A6C 8320 rem data docol
92 6A6E 70B2 data lit,')',word,drop2
92 6A70 0029
92 6A72 6AA2
92 6A74 75E0
93 6A76 832C data exit
94
95 6A78 6A66 trcomh data remh,immed+1
95 6A7A 8001
96 6A7C 5C20 text '\ '
97 6A7E 6A80 trcom data $+2
98 6A80 06A0 bl @bank1
98 6A82 8332
99 6A84 6B9A data _trcom
100
101 6A86 6A78 typcmh data trcomh,immed+2
101 6A88 8002
102 6A8A 2E28 text '.('
103 6A8C 8320 data docol,lit,41,word,type,cr,exit
103 6A8E 70B2
103 6A90 0029
103 6A92 6AA2
103 6A94 6C94
103 6A96 6E92
103 6A98 832C
104 ;]
105
106 ;[ WORD ( delimiter -- address length )
107 ; Moves through TIB in VDP memory, discarding leading delimiters, looking for
108 ; a word. A word is identified when a trailing delimiter is detected.
109 ; The word is copied from VDP to CPU memory.
110 ; Pushes the start address of the word (in CPU memory), and the length of
111 ; the word to the stack.
112 ; If no word is found (for example if we hit the end of the TIB without
113 ; detecting a word then 0 0 is pushed on the stack.
114
115 6A9A 6A86 wordh data typcmh,4
115 6A9C 0004
116 6A9E 574F text 'WORD'
116 6AA0 5244
117 6AA2 8320 word data docol
118 ; tib @ blk @ ?dup if nip block then
119 6AA4 773E data tib_,fetch
119 6AA6 6830
120 6AA8 7B4E word0 data blk,fetch,qdup,zbrnch,word2,nip,fblock
120 6AAA 6830
120 6AAC 61FC
120 6AAE 65F6
120 6AB0 6AB6
120 6AB2 61D2
120 6AB4 7C52
121 6AB6 6ABA word2 data word1
122 6AB8 832C data exit
123
124 ; at this point, data stack is ( delimeter address -- )
125 ; where address is the address in vdp to start searching from.
126 ; address is either TIB+>IN (if BLK=0) or block address+>IN
127 ; if BLK>0. (the code to add >IN to the address is in _word)
128 6ABA 6ABC word1 data $+2
129 6ABC 06A0 bl @bank1
129 6ABE 8332
130 6AC0 6B1A data _word ; see 1-08-Parsing.a99
131 ;]
132
133 ;[ BL ( -- 32 )
134 ; pushes 32 decimal to the stack. BL is short for 'BLANK' often used in with
135 ; word to specify the delimeter: e.g. BL WORD
136 6AC2 6A9A blh data wordh,2
136 6AC4 0002
137 6AC6 424C text 'BL'
138 6AC8 8320 bl_ data docol,lit,32,exit
138 6ACA 70B2
138 6ACC 0020
138 6ACE 832C
139 ;]
140
141 ;[ FIND addr1 len -- addr2 n 83
142 ; addr1 is the address of a string. The string contains a word name to be
143 ; located in the currently active search order. If the word is not found, addr2
144 ; is the string address addr1, and n is zero.
145 ; If the word is found, addr2 is the compilation address and n is set to one of
146 ; two non-zero values. If the word found has the immediate attribute,
147 ; n is set to one. If the word is non-immediate, n is set to minus one (true).
148 ; Len indicates the length of the string beginnig at addr1.
149 6AD0 6AC2 findh data blh,4
149 6AD2 0004
150 6AD4 4649 text 'FIND'
150 6AD6 4E44
151 6AD8 8320 find data docol,lit,fndvec,fetch,execut,exit
151 6ADA 70B2
151 6ADC A006
151 6ADE 6830
151 6AE0 72AA
151 6AE2 832C
152 6AE4 6AE6 vfind data $+2 ; vectored find
153 6AE6 C1B4 mov *stack+,r6 ; pop length to r6
154 6AE8 C1E0 mov @latest,r7 ; get address of last dictionary entry
154 6AEA A044
155 6AEC C227 fndnxt mov @2(r7),r8 ; length of dictionary entry
155 6AEE 0002
156 6AF0 0248 andi r8,>400f ; mask out immediate bit and block numbers
156 6AF2 400F
157 6AF4 8188 c r8,r6 ; are they the same length?
158 6AF6 1303 jeq lmatch ; jump if yes
159 6AF8 C1D7 find1 mov *r7,r7 ; point to next dictionary entry
160 6AFA 1326 jeq nomatch ; if 0 then no match. end of dictionary.
161 6AFC 10F7 jmp fndnxt ; else check the next entry
162 ; the length matches.
163 ; now do a character comparison between the word in the buffer and the word
164 ; in the dictionary
165 6AFE C287 lmatch mov r7,r10
166 6B00 022A ai r10,4 ; point to text of dictionary entry
166 6B02 0004
167 6B04 C014 mov *stack,r0 ; buffer address in r0
168 6B06 D070 cnxtch movb *r0+,r1 ; otherwise get a character from buffer
169 6B08 06A0 bl @caschk ; convert case if case sensitive=off
169 6B0A 6B4E
170 6B0C C381 mov r1,r14 ; save the character
171 6B0E D07A movb *r10+,r1 ; get character from dictionary entry
172 6B10 06A0 bl @caschk ; convert case if case sensitive=off
172 6B12 6B4E
173 6B14 9381 find2 cb r1,r14 ; compare the two characters
174 6B16 16F0 jne find1 ; if not equal then check next dict entry
175 6B18 0608 dec r8 ; decrememnt length
176 6B1A 16F5 jne cnxtch ; if not 0 then check next character
177 ; we have a match push cfa and word type
178 6B1C C227 mov @2(r7),r8 ; get length of dictionary entry
178 6B1E 0002
179 6B20 C248 mov r8,r9 ; make a copy
180 6B22 0248 andi r8,>f ; retain length only
180 6B24 000F
181 6B26 A1C8 a r8,r7 ; add length
182 6B28 0227 ai r7,4 ; take account of address & link field
182 6B2A 0004
183 6B2C 0587 inc r7 ; round up...
184 6B2E 0247 andi r7,>fffe ; ...to even address
184 6B30 FFFE
185 6B32 C507 mov r7,*stack ; push cfa
186 6B34 0644 dect stack ; prepare to push 'n' (see stack sig)
187 6B36 0249 l8000 andi r9,immed ; check immediate bit
187 6B38 8000
188 6B3A 1304 jeq noimm ; if not set then push -1 for status
189 6B3C 0201 li r1,1 ; else push a 1
189 6B3E 0001
190 6B40 C501 mov r1,*stack
191 6B42 045C b *next
192 6B44 0714 noimm seto *stack ; not immediate - push -1
193 6B46 045C b *next
194 6B48 0644 nomatch dect stack ; leave address unchanged on stack
195 6B4A 04D4 clr *stack ; 0=not found
196 6B4C 045C b *next
197 ; Convert lower case characters to upper case if case sensitivity is turned off
198 ; Input: r1 msb = character to test
199 ; Output: r1 msb = upper case character
200 6B4E D360 caschk movb @cassen,r13 ; case sensitive mode switched off?
200 6B50 A056
201 6B52 160B jne casout ; skip case conversion if switched off
202 6B54 D341 movb r1,r13 ; get the character in a spare register
203 6B56 098D srl r13,8 ; move to low byte
204 6B58 028D ci r13,'a' ; compare to a
204 6B5A 0061
205 6B5C 1106 jlt casout ; if less than it's not a lower case char
206 6B5E 028D ci r13,'z' ; else compare to z
206 6B60 007A
207 6B62 1503 jgt casout ; if greater than it's not a lower case char
208 6B64 020D li r13,-32*256 ; it's lower case. load -32 in the upper byte
208 6B66 E000
209 6B68 B04D ab r13,r1 ; subtract -32 from the upper byte.
210 ; char is now upper case
211 6B6A 045B casout rt
212 ;]
213
214 ;[ NUMBER ( address length -- number flag )
215 ; Attempts to convert the string at address into a number. If fully successful,
216 ; the number is placed on the stack and flag will be 0. If it fails (for example
217 ; contains an illegal character) then a partial number will be placed on the
218 ; stack (the value computed up until the failure) and flag will be >0.
219 ; Thus, if flag>0 the string failed to parse fully as a number.
220 ; A minus sign is permitted for negative numbers.
221 ; This routine uses BASE to parse numbers in the current BASE.
222 ; Eg. If BASE=16 then digits 0-9 and A-F are considered legal and will be
223 ; parsed properly.
224 ; A facility also exists called 'quick hex' that allows a number to be entered
225 ; in base 16, by placing a $ symbol at the end of the string. This avoids the
226 ; need to change BASE to enter a number. E.g. instead of HEX FEED DECIMAL you
227 ; can simply do $FEED. The number will be parsed as a HEX number without the
228 ; need to change BASE.
229 ; The numbers returned are (by default) singles (16 bits). NUMBER can can also
230 ; return a double (32-bit (2 stack cells)) value by including a period in the
231 ; number string. E.g. 100. 1.00 10.0 .100 will all return 100 decimal as a
232 ; double.
233 ; The various facilities can be mixed. For example, f. means -15 as a double.
234 ; - $ and . can be specified in any order. However, $ if required, should be
235 ; specified before any number digits. - and . can come anywhere in the string.
236 ; in the number string.
237 6B6C 6AD0 numbrh data findh,6
237 6B6E 0006
238 6B70 4E55 text 'NUMBER'
238 6B72 4D42
238 6B74 4552
239 6B76 8320 number data docol,lit,numvec,fetch,execut,exit ; fetch NUMBER vector & execute
239 6B78 70B2
239 6B7A A004
239 6B7C 6830
239 6B7E 72AA
239 6B80 832C
240 6B82 6B84 numbr1 data $+2
241 6B84 06A0 bl @bank1
241 6B86 8332
242 6B88 6BBA data _numbr ; see 1-08-Parsing.a99
243 ;]
244
245 ;[ EVALUATE ( i*x c-addr u -- j*x)
246 ; evaluates the string specified by c-addr u
247 ; the interpretation state is stored before evaluation and restored afterwards
248 ; should not be directly called within a block (or when BLK>0)
249 6B8A 6B6C evalh data numbrh,8
249 6B8C 0008
250 6B8E 4556 text 'EVALUATE'
250 6B90 414C
250 6B92 5541
250 6B94 5445
251 6B96 8320 eval data docol
252 6B98 770C data in_,fetch,rspush
252 6B9A 6830
252 6B9C 6290
253 6B9E 7B4E data blk,fetch,rspush
253 6BA0 6830
253 6BA2 6290
254 6BA4 7658 data span,fetch,rspush
254 6BA6 6830
254 6BA8 6290
255 6BAA 773E data tib_,fetch,rspush
255 6BAC 6830
255 6BAE 6290
256
257 6BB0 770C data in_,store0 ; zero >IN
257 6BB2 6892
258 6BB4 7B4E data blk,store0 ; zero BLK
258 6BB6 6892
259 6BB8 7658 data span,store ; load #tib with u
259 6BBA 6852
260 6BBC 773E data tib_,store ; load tib with c-addr
260 6BBE 6852
261
262 6BC0 609C data litm1,lit,source,store ; set SOURCE-ID to -1
262 6BC2 70B2
262 6BC4 A058
262 6BC6 6852
263 6BC8 72FE data interp ; call interpreter
264 6BCA 70B2 data lit,source,store0 ; zero SOURCE-ID
264 6BCC A058
264 6BCE 6892
265
266 6BD0 62AC data rspop,tib_,store
266 6BD2 773E
266 6BD4 6852
267 6BD6 62AC data rspop,span,store
267 6BD8 7658
267 6BDA 6852
268 6BDC 62AC data rspop,blk,store
268 6BDE 7B4E
268 6BE0 6852
269 6BE2 62AC data rspop,in_,store
269 6BE4 770C
269 6BE6 6852
270 6BE8 832C data exit
271 ;]
272
273 ;[ >CFA ( dictionary_address -- code_field_address)
274 ; Given a dictionary address returns the code-field address (CFA) of the word
275 6BEA 6B8A cfah data evalh,4
275 6BEC 0004
276 6BEE 3E43 text '>CFA'
276 6BF0 4641
277 6BF2 6BF4 cfa data $+2
278 6BF4 C094 _cfa mov *stack,r2 ; dictionary address
279 6BF6 C062 mov @2(r2),r1 ; word length
279 6BF8 0002
280 6BFA 0581 inc r1 ; round word length up to even number if odd
281 6BFC 0241 andi r1,>000e ; keep only rounded up length value
281 6BFE 000E
282 6C00 A042 a r2,r1 ; add length to dictionary address
283 6C02 8C71 c *r1+,*r1+ ; adjust by two words, one word for header
284 ; word, one word for length word.
285 ; we're now pointing at the CFA. nice trick
286 ; to add 4 to a register in only 2 bytes!
287 6C04 C501 mov r1,*stack ; move to stack
288 6C06 045C b *next ; NEXT
289 ;]
290
291 ;[ >BODY ( cfa -- body_address )
292 ; Given a CFA, returns the address of the body (the address of the "payload")
293 ; of words created with CREATE. E.g. VARIABLE, VALUE, CONSTANT
294 6C08 6BEA tbodyh data cfah,5
294 6C0A 0005
295 6C0C 3E42 text '>BODY '
295 6C0E 4F44
295 6C10 5920
296 6C12 839A tobody data _plus2 ; execute 2+ (see 0-03-Math.a99)
297 ;]
298
299 ;[ >LINK ( cfa -- link_field_address )
300 ; given a code field address, returns the address of the beginning of the dictionary
301 ; entry (the address of the link field).
302 6C14 6C08 dfah data tbodyh
303 6C16 0005 data 5
304 6C18 3E4C text '>LINK '
304 6C1A 494E
304 6C1C 4B20
305 6C1E 6C20 dfa data $+2
306 6C20 C020 mov @latest,r0 ; get latest dictionary entry
306 6C22 A044
307 6C24 C040 dfa1 mov r0,r1 ; copy it
308 6C26 05C0 inct r0 ; point to length
309 6C28 C090 mov *r0,r2 ; get the length
310 6C2A 0640 dect r0 ; point to beginning of dict entry again
311 6C2C 0242 andi r2,>f ; mask out immediate, hidden, and block
311 6C2E 000F
312 ; number, leaving length
313 6C30 A042 a r2,r1 ; add length
314 6C32 0581 inc r1 ; round up to...
315 6C34 0241 andi r1,>fffe ; ...word address
315 6C36 FFFE
316 6C38 05C1 inct r1 ; account for the length word itself
317 6C3A 05C1 inct r1
318 6C3C 8501 c r1,*stack ; is it what we're looking for?
319 6C3E 1303 jeq dfafnd ; jump if yes
320 6C40 C010 mov *r0,r0 ; otherwise walk the list
321 6C42 1301 jeq dfafnd ; if zero, we didn't find - push zero
322 6C44 10EF jmp dfa1 ; otherwise check the next entry in the list
323 6C46 C500 dfafnd mov r0,*stack ; place on stack
324 6C48 045C b *next
325 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-09-Console.a99'
*
1 ; _____ _ __ __ _
2 ; / ____| | | \ \ / / | |
3 ; | | ___ _ __ ___ ___ | | ___ \ \ /\ / /___ _ __ __| |___
4 ; | | / _ \| '_ \/ __|/ _ \| |/ _ \ \ \/ \/ // _ \| '__/ _` / __|
5 ; | |____| (_) | | | \__ \ (_) | | __/ \ /\ /| (_) | | | (_| \__ \
6 ; \_____|\___/|_| |_|___/\___/|_|\___| \/ \/ \___/|_| \__,_|___/
7 ; Console IO words
8
9 ;[ BREAK? ( -- )
10 ; scans keyboard and does an ABORT if break (FCTN 4) is pressed
11 6C4A 6C14 breakh data dfah,6
11 6C4C 0006
12 6C4E 4252 text 'BREAK?'
12 6C50 4541
12 6C52 4B3F
13 6C54 8320 break data docol,keyq,lit,2,eq,zbrnch,break1
13 6C56 6E62
13 6C58 70B2
13 6C5A 0002
13 6C5C 647A
13 6C5E 65F6
13 6C60 6C6E
14 6C62 6E92 data cr,toterm,brkmsg,5,cr,ab0rt
14 6C64 60B6
14 6C66 6C70
14 6C68 0005
14 6C6A 6E92
14 6C6C 7464
15 6C6E 832C break1 data exit
16 6C70 4272 brkmsg text 'Break '
16 6C72 6561
16 6C74 6B20
17 ;]
18
19 ;[ GOTOXY ( x y -- )
20 ; sets the screen cursor to the specified (0 based) x y screen coordinates
21 6C76 6C4A goxyh data breakh,6
21 6C78 0006
22 6C7A 474F text 'GOTOXY'
22 6C7C 544F
22 6C7E 5859
23 6C80 6C82 gotoxy data $+2
24 6C82 C834 mov *stack+,@scry ; pop y
24 6C84 A02A
25 6C86 C834 mov *stack+,@scrx ; pop x
25 6C88 A028
26 6C8A 045C b *next
27 ;]
28
29 ;[ TYPE addr +n -- M,79
30 ; +n characters are displayed from memory beginning with the character at addr
31 ; and continuing through consecutive addresses.
32 ; Nothing is displayed if +n is zero.
33 ; See: "9.5.4 TYPE"
34 6C8C 6C76 typeh data goxyh,4
34 6C8E 0004
35 6C90 5459 text 'TYPE'
35 6C92 5045
36 6C94 6C96 type data $+2
37 6C96 C374 type1 mov *stack+,r13 ; pop length in r13
38 6C98 C2B4 mov *stack+,r10 ; address in r10
39 6C9A C34D mov r13,r13 ; check the length
40 6C9C 120B jle typout ; if 0 or negative then exit
41 6C9E C020 mov @_wwrap,r0 ; check word-wrap
41 6CA0 A00A
42 6CA2 1609 jne dowwrap ; if <>0 then do word-wrap
43
44 6CA4 D1FA typlp movb *r10+,r7 ; get byte from string in r7 MSB
45 6CA6 06C7 swpb r7 ; rotate MSB into LSB
46 6CA8 0644 dect stack ; create space on stack
47 6CAA C507 mov r7,*stack ; place on stack
48 6CAC 06A0 bl @emit_ ; call emit
48 6CAE 6DA0
49 6CB0 060D dec r13 ; have we finished?
50 6CB2 16F8 jne typlp ; if not, repeat
51 6CB4 045C typout b *next
52
53 ; apply word-wrap behaviour
54 6CB6 10F6 dowwrap jmp typlp
55 ;]
56
57 ;[ WORDS ( -- )
58 ; displays a list of all the words in the dictionary
59 6CB8 6C8C wordsh data typeh,5
59 6CBA 0005
60 6CBC 574F text 'WORDS '
60 6CBE 5244
60 6CC0 5320
61 6CC2 8320 words_ data docol
62 6CC4 6E92 data cr,lit0,lates_
62 6CC6 6084
62 6CC8 76DE
63 6CCA 6830 words1 data fetch,dup,zbrnch,words2
63 6CCC 6186
63 6CCE 65F6
63 6CD0 6D02
64 6CD2 6186 data dup,plus2,dup,fetch,lit,15,and
64 6CD4 62CE
64 6CD6 6186
64 6CD8 6830
64 6CDA 70B2
64 6CDC 000F
64 6CDE 67D2
65 6CE0 617C data swap,plus2,swap,type
65 6CE2 62CE
65 6CE4 617C
65 6CE6 6C94
66 6CE8 6C54 words3 data break
67 6CEA 6E62 words4 data keyq,lit,>ffff,eq,zbrnch,words4
67 6CEC 70B2
67 6CEE FFFF
67 6CF0 647A
67 6CF2 65F6
67 6CF4 6CEA
68 6CF6 6D38 data space1,swap,plus1,swap
68 6CF8 617C
68 6CFA 62BA
68 6CFC 617C
69 6CFE 65E4 data branch,words1
69 6D00 6CCA
70 6D02 6172 words2 data drop,cr,dot
70 6D04 6E92
70 6D06 783C
71 6D08 60B6 data toterm,wftxt,6
71 6D0A 6D10
71 6D0C 0006
72 6D0E 832C data exit
73 6D10 576F wftxt text 'Words '
73 6D12 7264
73 6D14 7320
74 ;]
75
76 ;[ XY? ( -- x y )
77 ; places the cursor x and y coordinates on the stack
78 6D16 6CB8 xyh data wordsh,3
78 6D18 0003
79 6D1A 5859 text 'XY? '
79 6D1C 3F20
80 6D1E 6D20 xy data $+2
81 6D20 0644 dect stack ; new stack entry
82 6D22 C520 mov @scrX,*stack ; push scrX to stack
82 6D24 A028
83 6D26 0644 dect stack ; new stack entry
84 6D28 C520 mov @scrY,*stack ; push scrY to stack
84 6D2A A02A
85 6D2C 045C b *next
86 ;]
87
88 ;[ SPACE -- M,79
89 ; Displays an ASCII space.
90 6D2E 6D16 spaceh data xyh,5
90 6D30 0005
91 6D32 5350 text 'SPACE '
91 6D34 4143
91 6D36 4520
92 6D38 6D3A space1 data $+2
93 6D3A 0644 dect stack ; new stack entry
94 6D3C 0200 li r0,32 ; space character
94 6D3E 0020
95 6D40 C500 mov r0,*stack ; push it to stack
96 6D42 06A0 bl @emit_ ; call emit
96 6D44 6DA0
97 6D46 045C b *next
98 ;]
99
100 ;[ SPACES +n -- M,79
101 ; Displays +n ASCII spaces. Nothing is displayed if +n is zero.
102 6D48 6D2E spcesh data spaceh,6
102 6D4A 0006
103 6D4C 5350 text 'SPACES'
103 6D4E 4143
103 6D50 4553
104 6D52 6D54 spces data $+2
105 6D54 C1F4 mov *stack+,r7 ; pop count in r7
106 6D56 C1C7 mov r7,r7 ; check for 0
107 6D58 1309 jeq spcesx ; if zero, just quit
108 6D5A 0747 abs r7 ; make positive if negative
109 6D5C 0644 spces1 dect stack ; create stack entry
110 6D5E 0208 li r8,32 ; space character
110 6D60 0020
111 6D62 C508 mov r8,*stack ; put space on stack
112 6D64 06A0 bl @emit_ ; display the space via emit
112 6D66 6DA0
113 6D68 0607 dec r7 ; decrement count
114 6D6A 16F8 jne spces1 ; repeat if not finished
115 6D6C 045C spcesx b *next
116 ;]
117
118 ;[ PAGE ( -- )
119 ; clears screen
120 6D6E 6D48 clsh data spcesh,4
120 6D70 0004
121 6D72 5041 text 'PAGE'
121 6D74 4745
122 6D76 6D78 cls data $+2
123 6D78 06A0 bl @bank1
123 6D7A 8332
124 6D7C 6132 data _cls ; see 1-02-Console.a99
125 ;]
126
127 ;[ JOYST ( joystick# -- value )
128 ; Scans the joystick returning the direction value
129 6D7E 6D6E joysth data clsh,5
129 6D80 0005
130 6D82 4A4F text 'JOYST '
130 6D84 5953
130 6D86 5420
131 6D88 6D8A joyst data $+2
132 6D8A 06A0 bl @bank1 ; see 1-02-Console.a99
132 6D8C 8332
133 6D8E 615A data _joyst
134 ;]
135
136 ;[ EMIT 16b -- M,83
137 ; The least-significant 8-bit ASCII character is displayed. SEE: "9.5.3 EMIT"
138 6D90 6D7E emith data joysth,4
138 6D92 0004
139 6D94 454D text 'EMIT'
139 6D96 4954
140 6D98 6D9A emit data $+2
141 ; EMIT as called from the Forth environment:
142 6D9A 06A0 bl @emit_ ; call emit routine (see below)
142 6D9C 6DA0
143 6D9E 045C b *next
144
145 ; emit as an internal assembly sub-routine (used by SPACE, SPACES & TYPE):
146 6DA0 C24B emit_ mov r11,r9 ; save return address
147 6DA2 06A0 bl @ccp ; compute cursor position (loaded into r0)
147 6DA4 6F14
148 6DA6 C074 mov *stack+,r1 ; pop character
149 6DA8 06C1 swpb r1 ; get byte in msb
150 6DAA 06A0 bl @vsbw ; write char to screen at computed position
150 6DAC 7F9A
151 6DAE 05A0 inc @scrX ; increment x postion of cursor
151 6DB0 A028
152 6DB2 8820 c @scrx,@xmax ; have we hit the right-most column?
152 6DB4 A028
152 6DB6 A02C
153 6DB8 1301 jeq clipx ; if yes, reset x
154 6DBA 0459 b *r9 ; else return
155 6DBC 04E0 clipx clr @scrX ; reset x to 0
155 6DBE A028
156 6DC0 05A0 inc @scrY ; increment y
156 6DC2 A02A
157 6DC4 8820 c @scrY,@ymax ; have we hit the bottom of the screen?
157 6DC6 A02A
157 6DC8 A02E
158 6DCA 136F jeq scrlup ; if yes then scroll screen up
159 6DCC 0459 b *r9 ; else return
160 ;]
161
162 ;[ KEY -- 16b M,83
163 ; The least-significant 7 bits of 16b is the next ASCII character received.
164 ; All valid ASCII characters can be received.
165 ; Control characters are not processed by the system for any editing purpose.
166 ; Characters received by KEY will not be displayed.
167 ; See: "9.5.1 KEY"
168 0000 FF00 nokey equ >ff00 ; keycode for no key pressed
169 0000 0003 delkey equ 3 ; keycode for delete key
170
171 6DCE 6D90 kscnh data emith,3
171 6DD0 0003
172 6DD2 4B45 text 'KEY '
172 6DD4 5920
173 6DD6 6DD8 key data $+2
174 6DD8 04E0 clr @cursrd
174 6DDA A024
175 6DDC 06A0 bl @kscn ; call key scan routine
175 6DDE 6DE2
176 6DE0 045C b *next ; NEXT
177 ; keyscan has been split from the forth word KEY.
178 ; this allows it to be called both as a forth word (KEY) and as a machine
179 ; code routine.
180 6DE2 C20B kscn mov r11,r8 ; save return address
181 6DE4 06A0 kscn1 bl @cflash ; call cursor flash routine
181 6DE6 6E22
182 6DE8 D820 movb @keydev,@>8374 ; set keyboard to scan
182 6DEA A022
182 6DEC 8374
183 6DEE 02E0 lwpi >83e0 ; use gpl workspace
183 6DF0 83E0
184 6DF2 06A0 bl @>000e ; call keyboard scanning routine
184 6DF4 000E
185 ; restore the turboforth workspace
186 ; TFs workspace is held in 'wp'. This routine writes a program in the GPL
187 ; workspace starting at R0 which performs an LWPI instruction, and then
188 ; jumps the remainder of this keyscan routine below.
189 ;
190 6DF6 0200 li r0,>02e0 ; lwpi instruction
190 6DF8 02E0
191 6DFA C060 mov @wp,r1 ; lwpi operand
191 6DFC A012
192 6DFE 0202 li r2,>0460 ; branch opcode
192 6E00 0460
193 6E02 0203 li r3,kscn2 ; operand for branch instruction
193 6E04 6E08
194 6E06 0440 b r0
195 6E08 D1E0 kscn2 movb @gplst,r7 ; get GPL STATUS byte in r7 MSB
195 6E0A 837C
196 6E0C 0A37 sla r7,3 ; shift COND bit into carry bit
197 6E0E 17EA jnc kscn1 ; no key pressed, or same key pressed as
198 ; previous scan. ignore and re-scan.
199 6E10 D1E0 movb @keyin,r7 ; a new key was pressed: get ascii code in
199 6E12 8375
200 ; r7 msb
201 6E14 0287 ci r7,nokey ; compare against 'no key pressed' code
201 6E16 FF00
202 6E18 13E5 jeq kscn1 ; no key was pressed
203 6E1A 0987 srl r7,8 ; a key was pressed. move to low byte
204 6E1C 0644 dect stack ; new stack entry
205 6E1E C507 mov r7,*stack ; place ascii code onto stack
206 6E20 0458 b *r8 ; return to caller
207
208 ; cursor flashing
209 6E22 C820 cflash mov @bank0,@retbnk ; return to bank 0
209 6E24 606A
209 6E26 A06E
210 6E28 0300 limi 2 ; service isr
210 6E2A 0002
211 6E2C 0300 limi 0
211 6E2E 0000
212 6E30 C18B mov r11,r6 ; save return address
213 6E32 0207 li r7,>2000 ; load space & ascii 0 characters for cursor
213 6E34 2000
214 6E36 C020 mov @cursrd,r0 ; get cursor delay
214 6E38 A024
215 6E3A 0220 ai r0,>80 ; increment
215 6E3C 0080
216 6E3E C800 mov r0,@cursrd ; save it
216 6E40 A024
217 6E42 1305 jeq csrwrt ; if zero, write a blank cursor character
218 6E44 06C7 swpb r7 ; load _ cursor character
219 6E46 0280 ci r0,>8000 ; cursror delay = >8000?
219 6E48 8000
220 6E4A 1301 jeq csrwrt ; if yes, write an _ cursor character
221 6E4C 0456 b *r6 ; if neither, just return
222 6E4E 06A0 csrwrt bl @ccp ; call compute cursor position
222 6E50 6F14
223 6E52 C047 mov r7,r1 ; move cursor character to r1 for VSBW
224 6E54 06A0 bl @vsbw ; write the cursror character to the screen
224 6E56 7F9A
225 6E58 0456 b *r6 ; return to caller
226 ;]
227
228 ;[ KEY? ( -- ascii/-1 )
229 ; Scans keyboard and returns the ascii code of the key pressed,
230 ; or -1 if no key pressed
231 6E5A 6DCE keyqh data kscnh,4
231 6E5C 0004
232 6E5E 4B45 text 'KEY?'
232 6E60 593F
233 6E62 6E64 keyq data $+2
234 6E64 06A0 bl @keyqsr ; call as subroutine
234 6E66 6E6A
235 6E68 045C b *next
236 6E6A D820 keyqsr movb @keydev,@>8374 ; set keyboard to scan
236 6E6C A022
236 6E6E 8374
237 6E70 02E0 lwpi >83e0 ; use gpl workspace
237 6E72 83E0
238 6E74 06A0 bl @>000e ; call keyboard scanning routine
238 6E76 000E
239 6E78 02E0 lwpi wkspc ; restore to our workspace
239 6E7A 8300
240 6E7C D1E0 movb @keyin,r7 ; a new key was pressed: get ascii code in r7 msb
240 6E7E 8375
241 6E80 0887 sra r7,8 ; move to low byte
242 6E82 0644 dect stack ; make space on stack
243 6E84 C507 mov r7,*stack ; place value on stack
244 6E86 C80C mov r12,@>83d6 ; defeat auto screen blanking
244 6E88 83D6
245 6E8A 045B rt ; return to caller
246 ;]
247
248 ;[ CR -- M,79 "c-r"
249 ; Displays a carriage-return and line-feed or equivalent operation.
250 6E8C 6E5A crh data keyqh,2
250 6E8E 0002
251 6E90 4352 text 'CR'
252 6E92 6E94 cr data $+2
253 6E94 0209 li r9,crexit ; return address if we take the jump to scrlup
253 6E96 6EA8
254 6E98 04E0 clr @scrx ; clear cursor x coordinate
254 6E9A A028
255 6E9C 05A0 inc @scry ; move to next screen row
255 6E9E A02A
256 6EA0 8820 c @scry,@ymax ; have we hit the bottom of the screen?
256 6EA2 A02A
256 6EA4 A02E
257 6EA6 1301 jeq scrlup ; if yes, then scroll the screen
258 ; scrlup will return here via r9
259 6EA8 045C crexit b *next ; NEXT
260 ;]
261
262 ; Scroll screen up by one line. Used by EMIT and CR to scroll the screen up if
263 ; necessary (sub-routine, not a FORTH word).
264 6EAA C220 scrlup mov @noscrl,r8 ; test NOSCROLL
264 6EAC A026
265 6EAE 132D jeq scrlno ; scrolling is supressed
266 6EB0 0620 dec @scrY ; clip y coordinate to 23
266 6EB2 A02A
267 6EB4 C220 mov @here,r8
267 6EB6 A046
268 6EB8 0206 li r6,23 ; 23 lines to shift
268 6EBA 0017
269 6EBC 04C0 clr r0 ; screen address
270 6EBE A020 sclup_ a @xmax,r0 ; move down one line
270 6EC0 A02C
271 6EC2 C048 mov r8,r1 ; address of buffer to store in
272 6EC4 C0A0 mov @xmax,r2 ; number of bytes to store in the screen
272 6EC6 A02C
273 ; line buffer
274 6EC8 06A0 bl @vmbr ; read screen data into buffer
274 6ECA 7F82
275 6ECC 0520 neg @xmax ; set x negative
275 6ECE A02C
276 6ED0 A020 a @xmax,r0 ; move up one line
276 6ED2 A02C
277 6ED4 0520 neg @xmax ; restore x to positive
277 6ED6 A02C
278 6ED8 C0A0 mov @xmax,r2 ; number of bytes to write
278 6EDA A02C
279 6EDC C048 mov r8,r1 ; address of screen buffer
280 6EDE 06A0 bl @vmbw ; write buffer to screen
280 6EE0 7FC2
281 6EE2 A020 a @xmax,r0 ; move down a line
281 6EE4 A02C
282 6EE6 0606 dec r6 ; decrement number of lines left to shift
283 6EE8 16EA jne sclup_ ; repeat if not finished
284 6EEA C0A0 mov @here,r2
284 6EEC A046
285 6EEE C1A0 mov @xmax,r6 ; screen width
285 6EF0 A02C
286 6EF2 0201 li r1,>2020 ; two space characters
286 6EF4 2020
287 6EF6 CC81 blnkln mov r1,*r2+ ; write two spaces to the buffer
288 6EF8 0646 dect r6 ; decrement character count
289 6EFA 16FD jne blnkln ; loop if not finished
290 6EFC C060 mov @here,r1
290 6EFE A046
291 6F00 C0A0 mov @xmax,r2 ; number of bytes to write in r2
291 6F02 A02C
292 6F04 06A0 bl @vmbw ; write blank line
292 6F06 7FC2
293 6F08 0459 b *r9 ; return
294 6F0A 04E0 scrlno clr @scrY ; scrolling is supressed, so zero Y
294 6F0C A02A
295 6F0E 04E0 clr @scrX ; and x
295 6F10 A028
296 6F12 0459 b *r9 ; and return
297
298 ; compute cursor position. common utility routine.
299 ; used by EMIT and the cursor flash routine in KEY
300 6F14 C020 ccp mov @scry,r0 ; y coordinate of screen in r0
300 6F16 A02A
301 6F18 C060 mov @xmax,r1 ; horizontal screen size in r1
301 6F1A A02C
302 6F1C 3840 mpy r0,r1 ; multiply y by horizontal screen size.
303 ; result in r2
304 6F1E C002 mov r2,r0 ; move to r0 for vdp access routines
305 6F20 A020 a @scrX,r0 ; add x coordinate
305 6F22 A028
306 6F24 045B rt
307
308 ;[ BYE ( -- )
309 ; resets the console back to the title screen
310 6F26 6E8C byeh data crh,3
310 6F28 0003
311 6F2A 4259 text 'BYE '
311 6F2C 4520
312 6F2E 6F30 bye data $+2
313 6F30 04E0 clr @isr ; remove isr hook
313 6F32 83C4
314 6F34 0420 blwp @0 ; cold reset console. So long, old pal.
314 6F36 0000
315 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-10-Compilation.a99'
*
1 ; _____ _ _ _ __ __ _
2 ; / ____| (_) (_) \ \ / / | |
3 ; | | ___ _ __ ___ _ __ _| |_ _ __ __ _ \ \ /\ / /___ _ __ __| |___
4 ; | | / _ \| '_ ` _ \| '_ \| | | | '_ \ / _` | \ \/ \/ // _ \| '__/ _` / __|
5 ; | |____| (_) | | | | | | |_) | | | | | | | (_| | \ /\ /| (_) | | | (_| \__ \
6 ; \_____|\___/|_| |_| |_| .__/|_|_|_|_| |_|\__, | \/ \/ \___/|_| \__,_|___/
7 ; | | __/ |
8 ; |_| |___/
9 ; Compilation words...
10
11 ;[ HEADER ( TIB:string -- )
12 ; creates a word (from the input source) in the dictionary and links the
13 ; dictionary
14 ; *********************************************************************
15 ; NOTE: FOR VERSIONS 1.2.1 ONWARDS:
16 ; HEADER NOW DOES A "BL WORD" SEQUENCE INTERNALLY.
17 ; NO NEED TO DO A "BL WORD HEADER" SEQUENCE IN CODE THAT USES HEADER.
18 ; HEADER NOW DOES IT FOR YOU.
19 ; *********************************************************************
20 6F38 6F26 headrh data byeh,6
20 6F3A 0006
21 6F3C 4845 text 'HEADER'
21 6F3E 4144
21 6F40 4552
22 6F42 8320 header data docol
23 6F44 70EC data align ; ensure HERE is aligned
24 6F46 72B2 data spword ; get a word from the input source
25 6F48 6F4C data headr ; create and link new dictionary entry
26 6F4A 832C data exit
27 6F4C 6F4E headr data $+2
28 6F4E 06A0 bl @bank1
28 6F50 8332
29 6F52 6C92 data _headr ; see 1-09-Compilation.a99
30 ;]
31
32 ;[ MARKER ( -- )
33 ; creates a marker in the dictionary that, when executed, removes all words
34 ; following the marker from the dictionary, and resets the compilation address
35 ; to the first free address following the marker.
36 ; Example:
37 ; MARKER RESET \ create a marker called reset
38 ; : test1 1 2 3 ; \ define some words
39 ; : test2 4 5 6 ;
40 ; : test3 7 8 9 ;
41 ; RESET
42 ; In the example above, upon execution of RESET, the words test1 test2 & test3
43 ; are removed from the dictionary, LATEST points to the link field of RESET and
44 ; H points to the next cell after the end of the definition of RESET.
45 ; FFAIHM & FFAILM are also updated.
46 6F54 6F38 markrh data headrh,6
46 6F56 0006
47 6F58 4D41 text 'MARKER'
47 6F5A 524B
47 6F5C 4552
48 6F5E 8320 markr data docol
49 6F60 6F42 data header
50 6F62 7262 data compile,docol
50 6F64 8320
51 6F66 7262 data compile,domark
51 6F68 6F84
52 6F6A 76DE data lates_,fetch,comma
52 6F6C 6830
52 6F6E 70CC
53 6F70 780E data ghere,lit,6,add,comma
53 6F72 70B2
53 6F74 0006
53 6F76 631E
53 6F78 70CC
54 ; branch to code in FORGET to force update of FFAILM & FFAIHM...
55 ; data compile,branch,lit,forg1,comma
56 6F7A 7262 data compile,align
56 6F7C 70EC
57 6F7E 7262 DATA COMPILE,EXIT
57 6F80 832C
58 6F82 832C data exit
59 6F84 6F86 domark data $+2
60 6F86 C833 mov *pc+,@latest
60 6F88 A044
61 6F8A C833 mov *pc+,@here
61 6F8C A046
62 6F8E 045C b *next
63 ;]
64
65 ;[ CREATE -- M,79
66 ; A defining word executed in the form:
67 ; CREATE
68 ; Creates a dictionary entry for . After is created, the next
69 ; available dictionary location is the first byte of 's parameter field.
70 ; When is subsequently executed, the address of the first byte of
71 ; 's parameter field is left on the stack.
72 ; CREATE does not allocate space in 's parameter field.
73 6F90 6F54 creath data markrh,6
73 6F92 0006
74 6F94 4352 text 'CREATE'
74 6F96 4541
74 6F98 5445
75 6F9A 8320 create data docol
76 6F9C 6F42 data header ; create and link dictionary entry
77 6F9E 7262 data compile,crtime ; compile create's run-time to CREATEd CFA
77 6FA0 6FA4
78 6FA2 832C data exit
79
80 ; the run-time behaviour of all words created with CREATE is to leave their PFA
81 ; on the stack... Children of CREATE invoke the following code, called by the
82 ; inner interpreter:
83 6FA4 0644 crtime dect stack ; make room for PFA
84 6FA6 C506 mov r6,*stack ; place PFA on stack
85 6FA8 045C b *next
86 ;]
87
88 ;[ patches CFA of last created word with address of run-time code of parent.
89 ; address contained in PATCH. Used by DOES>
90 6FAA 6FAC altcfa data $+2
91 6FAC C020 mov @patch,r0 ; CFA of most recent definition
91 6FAE A06A
92 6FB0 C403 mov pc,*r0 ; patch it with parent's code field
93 6FB2 C0F5 mov *rstack+,pc ; in-line EXIT that "ends" the definition
94 6FB4 045C b *next ; into which altcfa is compiled
95 ;]
96
97 ;[ DODOES
98 ; dynamically compiles instructions (for run-time transition from child to
99 ; parent for DOES> words) into the parent DOES> word.
100 6FB6 8320 dodoes data docol
101 6FB8 7262 data compile,>0644 ; compile: "dect stack" instruction
101 6FBA 0644
102 6FBC 7262 data compile,>C506 ; compile: "mov r6,*stack" instruction
102 6FBE C506
103 6FC0 7262 data compile,>0645 ; compile: "dect rstack" instruction
103 6FC2 0645
104 6FC4 7262 data compile,>C543 ; compile: "mov pc,*rstack" instruction
104 6FC6 C543
105 6FC8 7262 data compile,>0203 ; compile: "li pc,xxx" instruction
105 6FCA 0203
106 ; calculate & compile address of xxx for li instruction:
107 6FCC 780E data ghere,lit,4,add,comma
107 6FCE 70B2
107 6FD0 0004
107 6FD2 631E
107 6FD4 70CC
108 6FD6 7262 data compile,>045C ; compile "b *next" instruction
108 6FD8 045C
109 6FDA 832C data exit
110 ;]
111
112 ;[ DOES> -- addr C,I,83 "does"
113 ; -- (compiling)
114 ; Defines the execution-time action of a word created by a high-level defining
115 ; word.
116 ; Used in the form:
117 ; : ... ... DOES> ... ;
118 ; and then
119 ;
120 ; where is CREATE or any user defined word which executes CREATE.
121 ;
122 ; Marks the termination of the defining part of the defining word and
123 ; then begins the definition of the execution-time action for words that will
124 ; later be defined by . When is later executed, the address of
125 ; 's parameter field is placed on the stack and then the sequence of words
126 ; between DOES> and ; are executed.
127 6FDC 6F90 doesh data creath,immed+5
127 6FDE 8005
128 6FE0 444F text 'DOES> '
128 6FE2 4553
128 6FE4 3E20
129 6FE6 8320 does data docol,compile,altcfa,dodoes,exit
129 6FE8 7262
129 6FEA 6FAA
129 6FEC 6FB6
129 6FEE 832C
130 ;]
131
132 ;[ CONSTANT 16b -- M,83
133 ; A defining word executed in the form:
134 ; 16b CONSTANT
135 ; Creates a dictionary entry for so that when is later executed,
136 ; 16b will be left on the stack.
137 6FF0 6FDC consth data doesh,8
137 6FF2 0008
138 6FF4 434F text 'CONSTANT'
138 6FF6 4E53
138 6FF8 5441
138 6FFA 4E54
139 6FFC 8320 const data docol
140 6FFE 6F42 data header ; create and link dictionary entry
141 7000 7262 data compile,docon ; compile reference to docon
141 7002 7008
142 7004 70CC data comma ; compile in the value of constant as an
143 ; argument to docon
144 7006 832C data exit
145
146 ; children of constant run this code...
147 7008 0644 docon dect stack ; make space on the data stack
148 700A C516 mov *r6,*stack ; push payload to the stack
149 700C 045C b *next
150 ;]
151
152 ;[ VARIABLE -- M,79
153 ; A defining word executed in the form:
154 ; VARIABLE
155 ; A dictionary entry for is created and two bytes are ALLOTted in its
156 ; parameter field.
157 ; This parameter field is to be used for contents of the variable.
158 ; When is later executed, the address of its parameter field is placed
159 ; on the stack.
160 700E 6FF0 varh data consth,8
160 7010 0008
161 7012 5641 text 'VARIABLE'
161 7014 5249
161 7016 4142
161 7018 4C45
162 701A 8320 var data docol,create,lit0,comma,exit
162 701C 6F9A
162 701E 6084
162 7020 70CC
162 7022 832C
163 ;]
164
165 ;[ VALUE ( n -- )
166 ; A "value" is actually a variable, but with more friendly syntax. VALUEs work
167 ; in conjunction with TO and +TO. (Perversely, they are implemented internally
168 ; using constants!)
169 ; A value can be initialised with a value at the time of creation:
170 ; 10 VALUE TEN - creates a word that pushes 10 to the stack when executed.
171 ; Note how the value was created and intialised at the same time. Using
172 ; standard variables, we would have to do:
173 ; VARIABLE TEN 10 TEN ! - two distinct steps.
174 ; To get the value of the value, just execute it:
175 ; 10 VALUE TEN TEN . 10 ok
176 ; Values, once created can have their values changed with the TO command:
177 ; 100 VALUE DELAY (creates a VALUE called delay with the value of 100)
178 ; 55 TO DELAY (changes the value of DELAY to 55)
179 ; Using standard variables, we would have to do:
180 ; VARIABLE DELAY
181 ; 100 DELAY !
182 ; 55 DELAY !
183 7024 700E valueh data varh,5
183 7026 0005
184 7028 5641 text 'VALUE '
184 702A 4C55
184 702C 4520
185 702E 8320 value data docol,const,exit
185 7030 6FFC
185 7032 832C
186 ; no coolness here, it's just a constant, the coolness is in TO & +TO
187 ;]
188
189 ;[ TO ( n -- )
190 ; Allows the value of an already created VALUE to be changed:
191 ; 100 VALUE SETPOINT (create a SETPOINT value with the value of 100)
192 ; 65 TO SETPOINT (change SETPOINTs value to 65)
193 7034 7024 toh data valueh,immed+2
193 7036 8002
194 7038 544F text 'TO'
195 703A 8320 data docol,toutil,zbrnch,tohx
195 703C 708C
195 703E 65F6
195 7040 704A
196 ; runs if in compile state. In compile state, a number will be on the
197 ; stack, so compile a reference to doto
198 7042 7262 data compile,doto ; compile reference to "do to"
198 7044 7056
199 7046 70CC data comma ; compile body address
200 7048 832C data exit
201
202 ; runs in interpret state - write the value on the stack to the body
203 ; address....
204 704A 6852 tohx data store,exit
204 704C 832C
205
206 704E 7034 dotoh data toh,4
206 7050 0004
207 7052 2854 text '(TO)'
207 7054 4F29
208 7056 7058 doto data $+2
209 7058 C033 mov *pc+,r0 ; get in-line body address
210 705A C434 mov *stack+,*r0 ; move tos to values' body
211 705C 045C b *next
212 ;]
213
214 ;[ +TO ( n -- )
215 ; Similar to TO above, but adds the value on the stack to the value.
216 ; 100 VALUE SETPOINT (create a value called SETPOINT with the value 100)
217 ; 25 +TO SETPOINT (changes SETPOINTs value to 125)
218 705E 704E addtoh data dotoh,immed+3
218 7060 8003
219 7062 2B54 text '+TO '
219 7064 4F20
220 7066 8320 data docol,ToUtil,zbrnch,addtox
220 7068 708C
220 706A 65F6
220 706C 7076
221 ; runs if in compile state. In compile state, a number will be on the
222 ; stack, so compile a reference to dopto ("do plus-to")
223 706E 7262 data compile,dopto ; compile reference to "do plus-to"
223 7070 7084
224 7072 70CC data comma ; compile body address
225 7074 832C data exit
226 ; runs in interpret state - write the value on the stack to the body
227 ; address....
228 7076 6860 addtox data stadd,exit
228 7078 832C
229
230 707A 705E ptoh data addtoh,5
230 707C 0005
231 707E 282B text '(+TO) '
231 7080 544F
231 7082 2920
232 7084 7086 dopto data $+2
233 7086 C033 mov *pc+,r0 ; get in-line body address
234 7088 A434 a *stack+,*r0 ; pop and add tos to value in the values' body
235 708A 045C b *next
236 ;]
237
238 ; common routine to get body and state. Used by TO and +TO save a few bytes by
239 ; making it common, and no run time penalty since this bit of code executes at
240 ; compile time.
241 ; ( -- body state)
242 ToUtil ; data docol,spword,find,drop,tobody,state_,fetch,exit
243 708C 8320 data docol,getword,tobody,state_,fetch,exit
243 708E 72BA
243 7090 6C12
243 7092 76CC
243 7094 6830
243 7096 832C
244
245 ;[ ALLOT w -- 79
246 ; Allocates w bytes in the dictionary.
247 ; The address of the next available dictionary entry is updated accordingly.
248 7098 707A alloth data ptoh,5
248 709A 0005
249 709C 414C text 'ALLOT '
249 709E 4C4F
249 70A0 5420
250 70A2 70A4 allot data $+2
251 70A4 06A0 bl @bank1
251 70A6 8332
252 70A8 6D2C data _allot ; see 1-09-Compilation.a99
253 ;]
254
255 ;[ LIT ( -- n )
256 ; places the literal number on the datastack
257 70AA 7098 lith data alloth,3
257 70AC 0003
258 70AE 4C49 text 'LIT '
258 70B0 5420
259 70B2 8368 lit data _lit ; runs from 16-bit ram
260 ;]
261
262 ;[ LITERAL -- 16b C,I,79
263 ; 16b -- (compiling)
264 ; Typically used in the form:
265 ; [ 16b ] LITERAL
266 ; Compiles a system dependent operation so that when later executed,
267 ; 16b will be left on the stack.
268 70B4 70AA literh data lith,immed+7
268 70B6 8007
269 70B8 4C49 text 'LITERAL '
269 70BA 5445
269 70BC 5241
269 70BE 4C20
270 70C0 8320 litral data docol
271 70C2 60AC data clc ; compile lit and value from stack
272 70C4 832C data exit
273 ;]
274
275 ;[ , 16b -- 79 "comma"
276 ; ALLOT space for 16b then store 16b at HERE 2- .
277 70C6 70B4 commah data literh,1
277 70C8 0001
278 70CA 2C20 text ', '
279 70CC 70CE comma data $+2
280 70CE 06A0 bl @bank1
280 70D0 8332
281 70D2 6CD0 data _comma ; see 1-09-Compilation.a99
282 ;]
283
284 ;[ C, (COMMA) ( value -- )
285 ; appends an 8 bit value, from the least significant byte of TOS to HERE.
286 ; Here is incremented by ONE BYTE, not one WORD.
287 ; For safety, use ALIGN to align HERE to a word boundary afterwards.
288 70D4 70C6 ccommh data commah,2
288 70D6 0002
289 70D8 432C text 'C,'
290 70DA 70DC ccomma data $+2
291 70DC 06A0 bl @bank1
291 70DE 8332
292 70E0 6CEE data _comab ; see 1-09-Compilation.a99
293 ;]
294
295 ;[ ALIGN ( -- )
296 ; Aligns HERE to an even word boundary by rounding up if required
297 ; Call it after using C!
298 70E2 70D4 alignh data ccommh,5
298 70E4 0005
299 70E6 414C text 'ALIGN '
299 70E8 4947
299 70EA 4E20
300 70EC 70EE align data $+2
301 70EE 06A0 bl @bank1
301 70F0 8332
302 70F2 6CFE data _align ; see 1-09-Compilation.a99
303 ;]
304
305 ;[ [ -- I,79 "left-bracket"
306 ; -- (compiling)
307 ; Sets interpret state.
308 ; The text from the input stream is subsequently interpreted.
309 ; For typical usage see LITERAL . See: ]
310 70F4 70E2 lbrakh data alignh,immed+1
310 70F6 8001
311 70F8 5B20 text '[ '
312 70FA 70FC lbrack data $+2
313 70FC 04E0 clr @_state ; set state to 0
313 70FE A048
314 7100 045C b *next
315 ;]
316
317 ;[ ] -- 79 "right-bracket"
318 ; Sets compilation state.
319 ; The text from the input stream is subsequently compiled.
320 ; For typical usage see LITERAL . See: [
321 7102 70F4 rbrakh data lbrakh,1
321 7104 0001
322 7106 5D20 text '] '
323 7108 710A rbrack data $+2
324 710A 0720 seto @_state ; set state to non zero
324 710C A048
325 710E 045C b *next
326 ;]
327
328 ;[ : -- sys M,79 "colon"
329 ; A defining word executed in the form:
330 ; : ... ;
331 ; Create a word definition for in the compilation vocabulary and set
332 ; compilation state.
333 ; The search order is changed so that the first vocabulary in the search order
334 ; is changed so that the first vocabulary in the search order is replaced by the
335 ; compilation vocabulary.
336 ; The compilation vocabulary is unchanged. The text from the input stream is
337 ; subsequently compiled.
338 ; is called a "colon definition".
339 ; The newly created word definition for cannot be found in the dictionary
340 ; until the corresponding ; or ; ;CODE is successfully processed.
341 ; An error condition exists if a word is not found and cannot be converted to a
342 ; number or if, during compilation from mass storage, the input stream is
343 ; exhausted before encountering ; or ;CODE.
344 ; sys is balanced with its corresponding ;
345 ; See: "compilation" "9.4 Compilation"
346 7110 7102 colonh data rbrakh,1
346 7112 0001
347 7114 3A20 text ': '
348 7116 8320 colon data docol
349 ; reset error detection reference counts....
350 7118 70B2 data lit,ifcnt,lit,sal-ifcnt,lit0,fill
350 711A A07C
350 711C 70B2
350 711E 000C
350 7120 6084
350 7122 6970
351 ; begin compilation...
352 7124 770C data in_,fetch ; save >IN
352 7126 6830
353 7128 6F42 data header ; create entry and link dictionary
354 712A 76DE data lates_,fetch,hideme ; set *this* entry as hidden
354 712C 6830
354 712E 721C
355 7130 770C data in_,store ; restore >IN
355 7132 6852
356 7134 72B2 data spword,find ; see if word already exists.
356 7136 6AD8
357 ; FIND won't find *this* instance!
358 7138 70B2 data lit,temp,store,drop ; store result in temp. used later by ;
358 713A A070
358 713C 6852
358 713E 6172
359 7140 7262 data compile,docol ; compile DOCOL
359 7142 8320
360 7144 7108 data rbrack ; switch on compile mode
361 7146 832C data exit
362
363 ;]
364
365 ;[ CODE: ( -- )
366 ; Defines a machine code word.
367 7148 7110 codeh data colonh,5
367 714A 0005
368 714C 434F text 'CODE: '
368 714E 4445
368 7150 3A20
369 7152 8320 data docol
370 7154 6F42 data header
371 7156 780E data ghere,plus2,comma
371 7158 62CE
371 715A 70CC
372 715C 609C data litm1,lit,coding,store
372 715E 70B2
372 7160 A068
372 7162 6852
373 7164 832C data exit
374 ;]
375
376 ;[ ;CODE ( -- )
377 ; ends a machine code definition
378 7166 7148 ecodeh data codeh,immed+5
378 7168 8005
379 716A 3B43 text ';CODE '
379 716C 4F44
379 716E 4520
380 7170 8320 ecode data docol
381 7172 70B2 data lit,>045c,comma,lit,coding,store0
381 7174 045C
381 7176 70CC
381 7178 70B2
381 717A A068
381 717C 6892
382 717E 832C data exit
383 ;]
384
385 ;[ ; -- C,I,79 "semi-colon"
386 ; sys -- (compiling)
387 ; Stops compilation of a colon definition, allows the of this colon
388 ; definition to be found in the dictionary, sets interpret state and compiles
389 ; EXIT (or a system dependent word which performs an equivalent function).
390 ; sys is balanced with its corresponding : .
391 ; See: EXIT : "stack, return" "9.4 Compilation"
392 7180 7166 semih data ecodeh,immed+1
392 7182 8001
393 7184 3B20 text '; '
394 7186 8320 semi data docol
395 7188 7262 data compile,exit ; compile EXIT
395 718A 832C
396 718C 76DE data lates_,fetch,hideme ; un-hide the word
396 718E 6830
396 7190 721C
397
398 ; flag to indicate no unbalanced errors detected...
399 7192 6084 data lit0
400
401 ; check IF...THEN reference counts, error if count>0...
402 7194 70B2 data lit,ifcnt,fetch,zbrnch,doerr
402 7196 A07C
402 7198 6830
402 719A 65F6
402 719C 71A6
403 719E 7204 data isserr
404 71A0 60B6 data toterm,iferr,7
404 71A2 7558
404 71A4 0007
405
406 ; check DO...LOOP reference counts, error if count>0...
407 71A6 70B2 doerr data lit,docnt,fetch,zbrnch,caserr
407 71A8 A07E
407 71AA 6830
407 71AC 65F6
407 71AE 71B8
408 71B0 7204 data isserr
409 71B2 60B6 data toterm,doertx,14
409 71B4 755F
409 71B6 000E
410
411 ; check CASE...ENDCASE reference counts, error if count>0
412 71B8 70B2 caserr data lit,cascnt,fetch,zbrnch,oferr
412 71BA A082
412 71BC 6830
412 71BE 65F6
412 71C0 71CA
413 71C2 7204 data isserr
414 71C4 60B6 data toterm,castxt,12
414 71C6 756D
414 71C8 000C
415
416 ; check OF...ENDOF reference counts, error if count>0
417 71CA 70B2 oferr data lit,ofcnt,fetch,zbrnch,begerr
417 71CC A084
417 71CE 6830
417 71D0 65F6
417 71D2 71DC
418 71D4 7204 data isserr
419 71D6 60B6 data toterm,oftxt,8
419 71D8 7579
419 71DA 0008
420
421 ; check BEGIN/UNTIL/REPEAT reference counts, error if count>0
422 71DC 70B2 begerr data lit,begcnt,fetch,zbrnch,allfin
422 71DE A086
422 71E0 6830
422 71E2 65F6
422 71E4 71EE
423 71E6 7204 data isserr
424 71E8 60B6 data toterm,begtxt,5
424 71EA 7581
424 71EC 0005
425
426 ; abort if one of the above error conditions exist
427 71EE 65F6 allfin data zbrnch,semi2 ; test unbalanced error flag
427 71F0 71F4
428 71F2 7464 data ab0rt
429
430 ; issue warning if this word is a re-definition...
431 71F4 70B2 semi2 data lit,temp,fetch,zbrnch,semi3 ; skip if not a redefinition
431 71F6 A070
431 71F8 6830
431 71FA 65F6
431 71FC 7200
432 71FE 74B6 data rdferr ; else issue warning if enabled
433 ; end of colon definition, reset compile state...
434 7200 70FA semi3 data lbrack ; go into interpret mode
435 7202 832C data exit
436
437 7204 8320 isserr data docol,cr,error,colnam,unbal
437 7206 6E92
437 7208 752C
437 720A 74CE
437 720C 74AC
438 720E 62BA data plus1 ; set unbalanced error detect to non-zero value
439 7210 832C data exit
440 ;]
441
442 ;[ HIDDEN ( dictionary_address -- )
443 ; toggles the hidden attribute on the dictionary entry
444 ; normally you would hide a word after defining it with: LATEST @ HIDDEN
445 7212 7180 hidh data semih,6
445 7214 0006
446 7216 4849 text 'HIDDEN'
446 7218 4444
446 721A 454E
447 721C 721E hideme data $+2
448 721E 06A0 bl @bank1
448 7220 8332
449 7222 6D0E data _hide
450 ;]
451
452 ;[ IMMEDIATE -- 79
453 ; Marks the most recently created dictionary entry as a word which will be
454 ; executed when encountered during compilation rather than compiled.
455 7224 7212 immh data hidh,9
455 7226 0009
456 7228 494D text 'IMMEDIATE '
456 722A 4D45
456 722C 4449
456 722E 4154
456 7230 4520
457 7232 7234 imm data $+2
458 7234 06A0 bl @bank1
458 7236 8332
459 7238 6D1C data _imm
460 ;]
461
462 ;[ ['] -- addr C,I,M,83 "bracket-tick"
463 ; -- (compiling)
464 ; Used in the form:
465 ; [']
466 ; Compiles the compilation address addr of as a literal.
467 ; When the colon definition is later executed addr is left on the stack.
468 ; An error condition exists if is not found in the currently active
469 ; search order. See: LITERAL
470 723A 7224 tickh data immh,immed+3
470 723C 8003
471 723E 5B27 text '[''] '
471 7240 5D20
472 tick ; data docol,spword,find,drop,litral,exit
473 7242 8320 data docol,getword,litral,exit
473 7244 72BA
473 7246 70C0
473 7248 832C
474
475 ;]
476
477 ;[ ' -- addr M,83 "tick"
478 ; Used in the form:
479 ; '
480 ; addr is the compilation address of .
481 ; An error condition exists if is not found in the currently active
482 ; search order.
483 724A 723A tick2h data tickh,1
483 724C 0001
484 724E 2720 text ''' '
485 7250 8320 tick2 data docol
486 ; data spword ; get a word from the TIB
487 ; data find ; find it in the dictionary
488 ; data zbrnch,tick2x ; jump if not found
489 ; data exit ; if found, exit, leaving cfa on the stack
490 ; tick2x data drop,lit0,exit ; not found - push 0
491 7252 72BA data getword
492 7254 832C data exit
493 ;]
494
495 ;[ COMPILE -- C,83
496 ; Typically used in the form:
497 ; : ... COMPILE ... ;
498 ; When is executed, the compilation address compiled for is
499 ; compiled and not executed.
500 ; is typically immediate and is typically not immediate.
501 ; See: "compilation"
502 7256 724A compih data tick2h,7
502 7258 0007
503 725A 434F text 'COMPILE '
503 725C 4D50
503 725E 494C
503 7260 4520
504 7262 7264 compile data $+2
505 ; note: the following line of code MUST be executed from bank 0.
506 ; It cannot execute in bank 1 because all the Forth CFAs are in bank 0.
507 7264 C073 mov *pc+,r1 ; get cfa of next word in thread
508 7266 06A0 bl @bank1 ; do the rest in bank 1
508 7268 8332
509 726A 6D36 data _compil ; see 1-09-Compilation.a99
510 ;]
511
512 ;[ [COMPILE] -- C,I,M,79 "bracket-compile"
513 ; -- (compiling)
514 ; Used in the form:
515 ; [COMPILE]
516 ; Forces compilation of the following word .
517 ; This allows compilation of an immediate word when it would otherwise have been
518 ; executed.
519 726C 7256 icomph data compih,immed+9
519 726E 8009
520 7270 5B43 text '[COMPILE] '
520 7272 4F4D
520 7274 5049
520 7276 4C45
520 7278 5D20
521 727A 8320 icomp data docol
522 727C 72B2 data spword ; get a word from TIB
523 727E 6AD8 data find,drop ; find it in the dictionary
523 7280 6172
524 7282 70CC data comma ; compile the CFA to HERE
525 7284 832C data exit
526 ;]
527
528 ;[ RECURSE ( -- )
529 ; RECURSE makes a recursive call to the current word that is being compiled.
530 ; Normally while a word is being compiled, it is marked HIDDEN so that
531 ; references to the same word within are calls to the previous definition of
532 ; the word. However we still have access to the word which we are currently
533 ; compiling through the LATEST pointer so we can use that to compile a
534 ; recursive call.
535 7286 726C recrsh data icomph,immed+7
535 7288 8007
536 728A 5245 text 'RECURSE '
536 728C 4355
536 728E 5253
536 7290 4520
537 7292 8320 recurs data docol
538 7294 76DE data lates_,fetch ; get LATEST on stack
538 7296 6830
539 7298 6BF2 data cfa ; convert to CFA
540 729A 70CC data comma ; compile it
541 729C 832C data exit
542 ;]
543
544 ;[ EXECUTE addr -- 79
545 ; The word definition indicated by addr is executed.
546 ; An error condition exists if addr is not a compilation address
547 729E 7286 exeh data recrsh,7
547 72A0 0007
548 72A2 4558 text 'EXECUTE '
548 72A4 4543
548 72A6 5554
548 72A8 4520
549 72AA 72AC execut data $+2
550 72AC C1B4 mov *stack+,r6 ; pop addr to r6
551 72AE C1F6 mov *r6+,r7 ; get cfa
552 72B0 0457 b *r7 ; execute it
553 ;]
554
555 ; little utility word to get a word using a space as a delimiter.
556 ; Saves a few bytes as it is used in multiple places.
557 72B2 8320 spword data docol,bl_,word,exit
557 72B4 6AC8
557 72B6 6AA2
557 72B8 832C
558
559
560 ; another utility word
561 ; gets a word from the input stream, finds it in the dictionary.
562 ; aborts if the word is not found in the dictionary.
563 72BA 8320 getword data docol
564 72BC 770C data in_,fetch,rspush
564 72BE 6830
564 72C0 6290
565 72C2 72B2 data spword,find,zbrnch,finderr
565 72C4 6AD8
565 72C6 65F6
565 72C8 72D0
566 72CA 62AC data rspop,drop
566 72CC 6172
567 72CE 832C data exit
568
569 72D0 62AC finderr data rspop,in_,store
569 72D2 770C
569 72D4 6852
570 72D6 72B2 data spword,type
570 72D8 6C94
571 72DA 60B6 data toterm,notick,10
571 72DC 72E6
571 72DE 000A
572 72E0 74CE data colnam
573 72E2 7464 data ab0rt
574 72E4 832C data exit
575 72E6 206E notick text ' not found'
575 72E8 6F74
575 72EA 2066
575 72EC 6F75
575 72EE 6E64
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-11-Interpreter.a99'
*
1 ; ______ _ _ _____ _ _
2 ; | ____| | | | | |_ _| | | | |
3 ; | |__ ___ _ __| |_| |__ | | _ __ | |_ ___ _ __ _ __ _ __ ___| |_ ___ _ __
4 ; | __/ _ \| '__| __| '_ \ | | | '_ \| __|/ _ \ '__| '_ \| '__/ _ \ __|/ _ \ '__|
5 ; | | | (_) | | | |_| | | | _| |_| | | | |_| __/ | | |_) | | | __/ |_| __/ |
6 ; |_| \___/|_| \__|_| |_| |_____|_| |_|\__|\___|_| | .__/|_| \___|\__|\___|_|
7 ; The interpreter/compiler | |
8 ; |_|
9
10 ;[ INTERPRET ( -- )
11 72F0 729E inth data exeh,9 ; points to execute in Compilation.a99
11 72F2 0009
12 72F4 494E text 'INTERPRET '
12 72F6 5445
12 72F8 5250
12 72FA 5245
12 72FC 5420
13 72FE 8320 interp data docol
14 7300 70B2 data lit,intvec,fetch,execut ; get the vector for INTERPRET and call it
14 7302 A000
14 7304 6830
14 7306 72AA
15 7308 832C data exit
16
17 ; standard, un-vectored INTERPRET
18 ; (an alternative interpreter can be installed by patching address INTVEC
19 ; defined in 0-22.system.a99)
20 730A 8320 intgo data docol
21 730C 72B2 intlp data spword ; (addr len) get a word from TIB
22 730E 6186 data dup ; (addr len len)
23 7310 65F6 data zbrnch,ok ; (addr len) if len is zero no identifiable
23 7312 7362
24 ; word was found, or TIB is empty
25 ; check the word identified by WORD, see if it's in the dictionary
26 7314 75EE data dup2 ; (addr len addr len)
27 7316 6AD8 data find ; (addr len cfa flag) see if the word is in
28 ; dictionary (flag=0 if not found)
29 7318 6186 data dup ; (addr len cfa flag flag)
30 731A 65F6 data zbrnch,chknum ; (addr len cfa flag) branch if not found
30 731C 734C
31
32 ; the word was found in the dictionary.
33 ; check STATE to see what to do with it.
34 ; (addr len cfa flag)
35 731E 70B2 data lit,_state,fetch ; (addr len cfa flag state)
35 7320 A048
35 7322 6830
36 7324 65F6 data zbrnch,state0 ; (addr len cfa flag) jump if interpreting
36 7326 7338
37
38 ; we're in compile mode (state=1)
39 ; compile the word, UNLESS the word is immediate
40 7328 62BA data plus1 ; (addr len cfa flag) flag=0 if not
41 ; immediate
42 732A 65F6 data zbrnch,nimm ; (addr len cfa) jump if not immediate
42 732C 7344
43
44 ; it's immediate - execute it
45 ; (addr len cfa)
46 732E 61D2 data nip,nip ; clean up stack
46 7330 61D2
47 7332 72AA data execut ; execute the word
48 7334 65E4 data branch,intlp ; repeat
48 7336 730C
49
50 ; we're interpreting. clean up stack and execute
51 ; (addr len cfa flag)
52 7338 6172 state0 data drop,nip,nip ; (cfa)
52 733A 61D2
52 733C 61D2
53 733E 72AA data execut ; (--)
54 7340 65E4 data branch,intlp ; repeat
54 7342 730C
55 ; word is not immediate - compile it
56 ; (addr len cfa)
57 7344 70CC nimm data comma ; (addr len)
58 7346 75E0 data drop2 ; (--)
59 7348 65E4 data branch,intlp ; repeat
59 734A 730C
60
61 ; no word found in dictionary, check to see if it's a number
62 ; on entry: (addr len cfa flag)
63 734C 75E0 chknum data drop2 ; (addr len)
64 734E 75EE data dup2 ; (addr len addr len)
65 7350 6B76 data number ; (addr len number ucc )
66 7352 65F6 data zbrnch,clean ; (addr len number ) if ucc=0 then number is
66 7354 7366
67 ; on the stack
68 ; clean up stack & check rest of tib
69
70 ; it's not a number or a word so we don't know what it is, error
71 7356 6172 ierr data drop ; (addr len) drop double number
72 7358 752C data error ; type ERROR: to the screen
73 735A 6C94 data type ; echo name of word
74 735C 749E data nferr ; issue not found error
75 735E 6E92 data cr,ab0rt
75 7360 7464
76
77 ; WORD didn't find anything...
78 ; on entry (addr len)
79 7362 75E0 ok data drop2 ; (--) clean up addr & len
80 7364 832C okx data exit
81
82 ; (addr len number )
83 ; at this point the number is on the top of the stack.
84 ; It may consist of one OR two words, depends if NUMBER returned a
85 ; double or not.
86 ; location isdbl shall be non zero if a double was returned
87
88 7366 70B2 clean data lit,isdbl,fetch ; double on the stack?
88 7368 A052
88 736A 6830
89 736C 65F6 data zbrnch,nodbl ; jump if not
89 736E 737C
90 7370 6190 data rot,drop,rot,drop ; clean up and leave 32 bit number on stack
90 7372 6172
90 7374 6190
90 7376 6172
91 7378 65E4 data branch,clean1
91 737A 738C
92 737C 61D2 nodbl data nip,nip ; clean up and leave 16 bit number on stack
92 737E 61D2
93
94 ; check for CODE: here...
95 7380 70B2 data lit,coding,fetch,zbrnch,nocode,comma
95 7382 A068
95 7384 6830
95 7386 65F6
95 7388 738C
95 738A 70CC
96
97
98 nocode
99 738C 70B2 clean1 data lit,_state,fetch ; ( number state ) get state
99 738E A048
99 7390 6830
100 7392 65F6 data zbrnch,intlp ; ( number ) if not compiling just leave on
100 7394 730C
101 ; the stack
102 7396 70B2 data lit,isdbl,fetch,zbrnch,csing ; jump if not compiling a double
102 7398 A052
102 739A 6830
102 739C 65F6
102 739E 73A4
103 73A0 617C data swap,clc ; compile high word of double
103 73A2 60AC
104 73A4 60AC csing data clc ; ( ) compile a single or low word of double
105
106 73A6 65E4 intout data branch,intlp
106 73A8 730C
107
108 73AA 70B2 badblk data lit,doboot,fetch
108 73AC A04E
108 73AE 6830
109 73B0 65F6 data zbrnch,badbk1
109 73B2 73B6
110 73B4 753A data nobootm ; display no boot message and abort
111 73B6 6E92 badbk1 data cr,toterm,blkmsg,10
111 73B8 60B6
111 73BA 75CB
111 73BC 000A
112 73BE 7796 data ioerr1,hexdot
112 73C0 7880
113 73C2 7464 noboot data ab0rt
114 ;]
115
116 ;[ STK? ( -- )
117 ; checks stack for underflow, aborts if underflow, else does nothing
118 73C4 72F0 stkufh data inth,4
118 73C6 0004
119 73C8 5354 text 'STK?'
119 73CA 4B3F
120 73CC 8320 stkuf data docol,depth,ltz,zbrnch,stkx
120 73CE 6240
120 73D0 64F0
120 73D2 65F6
120 73D4 73E2
121 73D6 752C data error,toterm,stktxt,10,cr,ab0rt
121 73D8 60B6
121 73DA 75AF
121 73DC 000A
121 73DE 6E92
121 73E0 7464
122 73E2 832C stkx data exit
123 ;]
124
125 ;[ FORGET -- M,83
126 ; Used in the form:
127 ; FORGET
128 ; If is found in the compilation vocabulary, delete from the
129 ; dictionary and all words added to the dictionary after regardless of
130 ; their vocabulary.
131 73E4 73C4 forgth data stkufh,6
131 73E6 0006
132 73E8 464F text 'FORGET'
132 73EA 5247
132 73EC 4554
133 73EE 8320 forget data docol,spword,find,zbrnch,notfnd ; find word cfa in dictionary
133 73F0 72B2
133 73F2 6AD8
133 73F4 65F6
133 73F6 7424
134 73F8 6C1E data dfa,dup ; get dictionary entry address
134 73FA 6186
135 73FC 6830 data fetch,lates_,store ; update latest
135 73FE 76DE
135 7400 6852
136 7402 76EC data here_,store ; update H
136 7404 6852
137 7406 70EC data align ; force update of appropriate hi or low mem pointer
138 7408 780E forg1 data ghere ; save HERE
139 740A 7750 data ffaih,fetch,here_,store,align ; force update of FFAIHM
139 740C 6830
139 740E 76EC
139 7410 6852
139 7412 70EC
140 7414 7766 data ffaml,fetch,here_,store,align ; force update of FFAILM
140 7416 6830
140 7418 76EC
140 741A 6852
140 741C 70EC
141 741E 76EC data here_,store ; restore here
141 7420 6852
142 7422 832C data exit
143 7424 6172 notfnd data drop,exit ; take no action if not found
143 7426 832C
144 ;]
145
146 ;[ ABORT" flag -- C,I,83 "abort-quote"
147 ; -- (compiling)
148 ; Used in the form:
149 ; flag ABORT" ccc"
150 ; When later executed, if flag is true the characters ccc, delimited by "
151 ; (close-quote), are displayed and then a system dependent error abort sequence,
152 ; including the function of ABORT , is performed.
153 ; If flag is false, the flag is dropped and execution continues.
154 ; The blank following ABORT" is not part of ccc.
155 7428 73E4 aborth data forgth,immed+6
155 742A 8006
156 742C 4142 abttxt text 'ABORT"'
156 742E 4F52
156 7430 5422
157 7432 8320 abort data docol,string,compile,rot,compile,zbrnch,ghere,lit,4,add,comma
157 7434 7900
157 7436 7262
157 7438 6190
157 743A 7262
157 743C 65F6
157 743E 780E
157 7440 70B2
157 7442 0004
157 7444 631E
157 7446 70CC
158 7448 7262 data compile,abort_,compile,drop2,exit
158 744A 7452
158 744C 7262
158 744E 75E0
158 7450 832C
159 7452 8320 abort_ data docol,type,cr,ab0rt
159 7454 6C94
159 7456 6E92
159 7458 7464
160 ;]
161
162 ;[ ABORT 79
163 ; Clears the data stack and performs the function of QUIT.
164 ; No message is displayed.
165 745A 7428 ab0rth data aborth,5
165 745C 0005
166 745E 4142 text 'ABORT '
166 7460 4F52
166 7462 5420
167 7464 8320 ab0rt data docol
168 7466 6E92 data cr,s0_,sps,lbrack,clsall
168 7468 77B4
168 746A 76A8
168 746C 70FA
168 746E 7496
169 7470 7B4E data blk,store0 ; reset block to 0 in case we're loading
169 7472 6892
170 7474 70B2 data lit,lstblk,store0
170 7476 A1B4
170 7478 6892
171 747A 70B2 data lit,tib,tib_,store ; reset address of terminal input buffer
171 747C 3420
171 747E 773E
171 7480 6852
172 7482 770C data in_,store0 ; set >IN to 0
172 7484 6892
173 7486 70B2 data lit,80,cpl,store ; set 80 characters per line
173 7488 0050
173 748A 7668
173 748C 6852
174 748E 70B2 data lit,source,store0 ; reset EVALUATE source
174 7490 A058
174 7492 6892
175 7494 6124 data quit ; call quit
176
177 7496 7498 clsall data $+2
178 7498 06A0 bl @bank1 ; close all open files
178 749A 8332
179 749C 7B46 data _clall ; see 1-14-File-IO.a99
180 ;]
181
182 ;[ VTYPE ( vdp_addr len -- )
183 ; types a string stored in vdp to the screen
184 ; vtypeh data ab0rth,5
185 ; text 'VTYPE '
186 ; vtype data docol,dup,nrot,pad,swap,fvmbr,pad,swap,type,exit
187 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-12-Errors.a99'
*
1 ; ______ __ __
2 ; | ____| | \/ |
3 ; | |__ _ __ _ __ ___ _ __ | \ / | ___ ___ ___ __ _ __ _ ___ ___
4 ; | __| | '__| '__/ _ \| '__| | |\/| |/ _ | __/ __|/ _` |/ _` |/ _ | __|
5 ; | |____| | | | | (_) | | | | | | __|__ \__ \ (_| | (_| | __|__ \
6 ; |______|_| |_| \___/|_| |_| |_|\___|___/___/\__,_|\__, |\___|___/
7 ; Error reporting routines __/ |
8 ; |___/
9
10
11 ; word not found error, used by INTERPRET
12 749E 8320 nferr data docol,toterm,nftxt,10 ; echo 'not found'
12 74A0 60B6
12 74A2 75A1
12 74A4 000A
13 74A6 608C data lit1,colnam ; report name of colon definition if in a colon
13 74A8 74CE
14 ; definition
15 74AA 832C data exit
16
17
18 ; type the word 'Unbalanced ' to the terminal... used by ;
19 74AC 8320 unbal data docol,toterm,baltxt,11,exit
19 74AE 60B6
19 74B0 7596
19 74B2 000B
19 74B4 832C
20
21
22 ; warning message. issued when a word is re-defined. used by ;
23 74B6 8320 rdferr data docol,warn,fetch,zbrnch,rdfer1
23 74B8 772E
23 74BA 6830
23 74BC 65F6
23 74BE 74CC
24 74C0 6E92 data cr,toterm,rdftxt,10,lit0,colnam ; issue warning
24 74C2 60B6
24 74C4 7586
24 74C6 000A
24 74C8 6084
24 74CA 74CE
25 74CC 832C rdfer1 data exit
26
27
28 ; if we are in a colon definition (state!=0) then echo the name of the
29 ; colon definition (via LATEST), else skip.
30 74CE 8320 colnam data docol
31 74D0 70B2 data lit,_state,fetch,zbrnch,errxit
31 74D2 A048
31 74D4 6830
31 74D6 65F6
31 74D8 7500
32 74DA 65F6 data zbrnch,colnm1
32 74DC 74E4
33 74DE 60B6 data toterm,intxt,4
33 74E0 75AB
33 74E2 0004
34 74E4 70B2 colnm1 data lit,latest,fetch ; get latest
34 74E6 A044
34 74E8 6830
35 74EA 62CE data plus2 ; move to length word
36 74EC 6186 data dup,fetch ; copy address, and fetch length
36 74EE 6830
37 74F0 70B2 data lit,>f,and ; get length only
37 74F2 000F
37 74F4 67D2
38 74F6 617C data swap,plus2 ; compute address of word text
38 74F8 62CE
39 74FA 617C data swap,type,space1 ; type the name to the terminal
39 74FC 6C94
39 74FE 6D38
40
41 errxit ; reports block number if loading...
42 7500 7B4E data blk,fetch,zbrnch,repxit
42 7502 6830
42 7504 65F6
42 7506 752A
43 7508 60B6 data toterm,blctxt,10,lit,lstblk,fetch,udot
43 750A 75B9
43 750C 000A
43 750E 70B2
43 7510 A1B4
43 7512 6830
43 7514 782C
44 7516 6E92 data cr,toterm,linnum,8,in_,fetch,lit,64,sdiv,dot
44 7518 60B6
44 751A 75C3
44 751C 0008
44 751E 770C
44 7520 6830
44 7522 70B2
44 7524 0040
44 7526 63C6
44 7528 783C
45 752A 832C repxit data exit
46
47
48 ; writes "ERROR:" used by all error routines
49 752C 8320 error data docol,cr
49 752E 6E92
50 7530 60B6 data toterm,errtxt,6,cr ; write ERROR:
50 7532 7590
50 7534 0006
50 7536 6E92
51 7538 832C data exit
52
53 753A 8320 nobootm data docol,cr,lit,pabfil,lit,pabnln,chrftc,type
53 753C 6E92
53 753E 70B2
53 7540 A18A
53 7542 70B2
53 7544 A189
53 7546 686E
53 7548 6C94
54 754A 60B6 data toterm,nftxt,10,lit,doboot,store0,ab0rt
54 754C 75A1
54 754E 000A
54 7550 70B2
54 7552 A04E
54 7554 6892
54 7556 7464
55
56
57 ; text for the various error types trapped by ;...
58 7558 4946 iferr text 'IF/THEN'
58 755A 2F54
58 755C 4845
58 755E 4E
59 755F 464F doertx text 'FOR or DO loop'
59 7561 5220
59 7563 6F72
59 7565 2044
59 7567 4F20
59 7569 6C6F
59 756B 6F70
60 756D 4341 castxt text 'CASE/ENDCASE'
60 756F 5345
60 7571 2F45
60 7573 4E44
60 7575 4341
60 7577 5345
61 7579 4F46 oftxt text 'OF/ENDOF'
61 757B 2F45
61 757D 4E44
61 757F 4F46
62 7581 4245 begtxt text 'BEGIN'
62 7583 4749
62 7585 4E
63
64
65 ; general error text...
66 7586 5265 rdftxt text 'Redefined '
66 7588 6465
66 758A 6669
66 758C 6E65
66 758E 6420
67 7590 4552 errtxt text 'ERROR:'
67 7592 524F
67 7594 523A
68 7596 556E baltxt text 'Unbalanced '
68 7598 6261
68 759A 6C61
68 759C 6E63
68 759E 6564
68 75A0 20
69 75A1 206E nftxt text ' not found'
69 75A3 6F74
69 75A5 2066
69 75A7 6F75
69 75A9 6E64
70 75AB 2069 intxt text ' in '
70 75AD 6E20
71 75AF 556E stktxt text 'Underflow!'
71 75B1 6465
71 75B3 7266
71 75B5 6C6F
71 75B7 7721
72 75B9 2069 blctxt text ' in block '
72 75BB 6E20
72 75BD 626C
72 75BF 6F63
72 75C1 6B20
73 75C3 6F6E linnum text 'on line '
73 75C5 206C
73 75C7 696E
73 75C9 6520
74 75CB 494F blkmsg text 'IO error #'
74 75CD 2065
74 75CF 7272
74 75D1 6F72
74 75D3 2023
75
76 75D5 0000 even
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-13-Double.a99'
*
1 ; ____ ___ _ _ _ __ __ _
2 ; |___ \__ \ | | (_) | \ \ / / | |
3 ; __) | ) |______| |__ _| |_ \ \ /\ / /___ _ __ __| |___
4 ; |__ < / /|______| '_ \| | __| \ \/ \/ // _ \| '__/ _` / __|
5 ; ___) / /_ | |_) | | |_ \ /\ /| (_) | | | (_| \__ \
6 ; |____/____| |_.__/|_|\__| \/ \/ \___/|_| \__,_|___/
7
8 ; ########################################
9 ; Double Number Extension Word Set
10 ; Words to provide 32 bit math facilities
11 ; ########################################
12 ; Note: To save memory, these words may be removed completely and added to a
13 ; support file on disk.
14
15 ;[ 2DROP ( d -- )
16 75D6 745A drop2h data ab0rth,5
16 75D8 0005
17 75DA 3244 text '2DROP '
17 75DC 524F
17 75DE 5020
18 75E0 75E2 drop2 data $+2
19 75E2 8D34 c *stack+,*stack+ ; pop 2 words off the stack (cool, eh?)
20 75E4 045C b *next
21 ;]
22
23 ;[ 2DUP ( d -- d d )
24 75E6 75D6 dup2h data drop2h,4
24 75E8 0004
25 75EA 3244 text '2DUP'
25 75EC 5550
26 75EE 75F0 dup2 data $+2
27 75F0 06A0 bl @bank1
27 75F2 8332
28 75F4 6B0A data _dup2 ; see 1-07-Double.a99
29 ;]
30
31 ; 2SWAP ( a b c d -- c d a b )
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-14-Variables.a99'
*
1
2 ; __ __ _ _ _
3 ; \ \ / / (_) | | | |
4 ; \ \ / /__ _ _ __ _ __ _| |__ | | ___ ___
5 ; \ \/ // _` | '__| |/ _` | '_ \| |/ _ | __|
6 ; \ /| (_| | | | | (_| | |_) | | __|__ \
7 ; \/ \__,_|_| |_|\__,_|_.__/|_|\___|___/
8
9 ;[ UNSIGNED ( -- address ) (variable)
10 ; places the address of the signed number variable on the stack
11 ; this variable is used by the number to string routine to determine if a number should be
12 ; treated as signed or unsigned when converting into a string (normally for displaying).
13 ; If >0, then numbers will be converted as unsigned. This variable is set by U. and .
14 ; but can also be useful in user programs.
15 75F6 75E6 usignh data dup2h,8
15 75F8 0008
16 75FA 554E text 'UNSIGNED'
16 75FC 5349
16 75FE 474E
16 7600 4544
17 7602 7604 usignd data $+2
18 7604 0206 li r6,dotsin
18 7606 A05A
19 7608 102A jmp span1
20 ;]
21
22 ;[ WWRAP ( -- address ) (variable)
23 ; places the address of the WWRAP variable on the stack.
24 ; TYPE observes WWRAP. If WWRAP is false (0) then TYPE will not apply word wrap
25 ; to the typed line. When WWRAP<>0 then word wrap behaviour will be applied.
26 760A 75F6 wwraph data usignh,5
26 760C 0005
27 760E 5757 text 'WWRAP '
27 7610 5241
27 7612 5020
28 7614 7616 wwrap data $+2
29 7616 0206 li r6,_wwrap
29 7618 A00A
30 761A 1021 jmp span1
31 ;]
32
33 ;[ #BUF ( -- address ) (variable)
34 ; number of disk buffers - minimum is one
35 761C 760A nbufh data wwraph,4
35 761E 0004
36 7620 2342 text '#BUF'
36 7622 5546
37 7624 7626 nbuf data $+2
38 7626 0206 li r6,totblk
38 7628 A1B0
39 762A 1019 jmp span1
40 ;]
41
42 ;[ SSCROLL ( -- address ) (variable)
43 ; places address of NOSCROLL variable on the stack
44 ; used to determine if the command line environment
45 762C 761C noscrh data nbufh,7
45 762E 0007
46 7630 5353 text 'SSCROLL '
46 7632 4352
46 7634 4F4C
46 7636 4C20
47 7638 763A noscr data $+2
48 763A 0206 li r6,noscrl
48 763C A026
49 763E 100F jmp span1
50 ;]
51
52 ;[ CSEN ( -- address ) (variable)
53 ; places address of CASE variable on the stack
54 ; When CSEN>0 the system is case sensitive
55 7640 762C sensh data noscrh,4
55 7642 0004
56 7644 4353 text 'CSEN'
56 7646 454E
57 7648 764A sens data $+2
58 764A 0206 li r6,cassen
58 764C A056
59 764E 1007 jmp span1
60 ;]
61
62 ;[ SPAN -- addr U,83 "number-t-i-b"
63 ; The address of a variable containing the number of bytes placed into the text input buffer by EXPECT.
64 7650 7640 htibh data sensh,4
64 7652 0004
65 7654 5350 text 'SPAN'
65 7656 414E
66 7658 765A span data $+2
67 765A 0206 li r6,_span
67 765C A04C
68 765E 107B span1 jmp dovar
69 ;]
70
71 ;[ #TIB ( -- address ) (variable)
72 ; returns a pointer to the size of the text input buffer
73 7660 7650 cplh data HTIBH,4
73 7662 0004
74 7664 2354 text '#TIB'
74 7666 4942
75 7668 766A cpl data $+2
76 766A 0206 li r6,tibsiz
76 766C A04A
77 766E 1073 jmp dovar
78 ;]
79
80 ;[ WRAP ( -- address ) (variable)
81 ; places address of WRAP variable on the stack
82 ; used to determine if the SCROLL command does wrap-around or not
83 7670 7660 wraph data cplh,4
83 7672 0004
84 7674 5752 text 'WRAP'
84 7676 4150
85 7678 767A wrap_ data $+2
86 767A 0206 li r6,wrap
86 767C A030
87 767E 106B jmp dovar
88 ;]
89
90 ;[ ZEROS ( -- address ) (variable)
91 ; places address of LZI variable on the stack
92 ; used to set if leading zeros are displyed when displaying numbers
93 7680 7670 zerosh data wraph,5
93 7682 0005
94 7684 5A45 text 'ZEROS '
94 7686 524F
94 7688 5320
95 768A 768C zeros data $+2
96 768C 0206 li r6,lzi
96 768E A062
97 7690 1062 jmp dovar
98 ;]
99
100 ;[ SP@ ( -- address ) (constant)
101 ; places current address of stack pointer on the stack
102 7692 7680 spfh data zerosh,3
102 7694 0003
103 7696 5350 text 'SP@ '
103 7698 4020
104 769A 769C spf data $+2
105 769C C184 mov stack,r6 ; address of stack pointer in r6
106 769E 105B jmp dovar
107 ;]
108
109 ;[ SP! ( address -- ) (function)
110 ; set stack pointer address - use with caution!
111 76A0 7692 spsh data spfh,3
111 76A2 0003
112 76A4 5350 text 'SP! '
112 76A6 2120
113 76A8 76AA sps data $+2
114 76AA C114 mov *stack,stack ; set stack pointer
115 76AC C804 mov stack,@s0 ; set S0
115 76AE A01E
116 76B0 0644 spsx dect stack ; adjust for pre-increment
117 76B2 045C b *next
118 ;]
119
120 ;[ RP@ ( -- address ) (variable)
121 ; places current address of return stack pointer on the stack
122 76B4 76A0 rpfh data spsh,3
122 76B6 0003
123 76B8 5250 text 'RP@'
123 76BA 40
124 76BB 0000 EVEN *>>> Assembler Auto-Generated <<<
125 76BC 76BE rpf data $+2
126 76BE C185 mov rstack,r6 ; address of return stack pointer in r6
127 76C0 104A jmp dovar
128 ;]
129
130 ;[ STATE -- addr U,79
131 ; The address of a variable containing the compilation state. A non-zero content indicates
132 ; compilation is occurring, but the value itself is system dependent. A Standard Program
133 ; may not modify this variable.
134 76C2 76B4 stateh data rpfh,5
134 76C4 0005
135 76C6 5354 text 'STATE '
135 76C8 4154
135 76CA 4520
136 76CC 76CE state_ data $+2
137 76CE 0206 li r6,_state
137 76D0 A048
138 76D2 1041 jmp dovar
139 ;]
140
141 ;[ LATEST ( -- address ) (variable)
142 ; returns the *address* of LATEST on the stack
143 76D4 76C2 latesh data stateh,6
143 76D6 0006
144 76D8 4C41 text 'LATEST'
144 76DA 5445
144 76DC 5354
145 76DE 76E0 lates_ data $+2
146 76E0 0206 li r6,latest
146 76E2 A044
147 76E4 1038 jmp dovar
148 ;]
149
150 ;[ H ( -- address ) (variable)
151 ; returns the *address* of HERE on the stack - note lowercase
152 ; see the constant, HERE
153 76E6 76D4 hereh data latesh,1
153 76E8 0001
154 76EA 4820 text 'H '
155 76EC 76EE here_ data $+2
156 76EE 0206 li r6,here
156 76F0 A046
157 76F2 1031 jmp dovar
158 ;]
159
160 ;[ BASE -- addr U,83
161 ; The address of a variable containing the current numeric conversion radix.
162 ; {{2..36}}
163 76F4 76E6 baseh data hereh,4
163 76F6 0004
164 76F8 4241 text 'BASE'
164 76FA 5345
165 76FC 76FE base_ data $+2
166 76FE 0206 li r6,base
166 7700 A05C
167 7702 1029 jmp dovar
168 ;]
169
170 ;[ >IN -- addr U,79 "to-in"
171 ; The address of a variable which contains the present character offset within
172 ; the input stream {{0..the number of characters in the input stream}}.
173 ; See: WORD
174 7704 76F4 inh data baseh,3
174 7706 0003
175 7708 3E49 text '>IN '
175 770A 4E20
176 770C 770E in_ data $+2
177 770E 0206 li r6,in
177 7710 A042
178 7712 1021 jmp dovar
179 ;]
180
181 ;[ KMODE ( -- address ) (variable)
182 ; returns the address of keydev, the keyscan mode
183 7714 7704 kmodh data inh,5
183 7716 0005
184 7718 4B4D text 'KMODE '
184 771A 4F44
184 771C 4520
185 771E 7720 kmode data $+2
186 7720 0206 li r6,keydev
186 7722 A022
187 7724 1018 jmp dovar
188 ;]
189
190 ;[ WARN ( -- address ) (variable)
191 ; returns the address of keydev, the keyscan mode
192 7726 7714 warnh data kmodh,4
192 7728 0004
193 772A 5741 text 'WARN'
193 772C 524E
194 772E 7730 warn data $+2
195 7730 0206 li r6,_warn
195 7732 A066
196 7734 1010 jmp dovar
197 ;]
198
199 ;[ TIB -- addr 83 "t-i-b"
200 ; The address of the text input buffer.
201 ; This buffer is used to hold characters when the input stream is coming from
202 ; the current input device. The minimum capacity of TIB is 80 characters.
203 ; Note: TIB is a VDP address, unless SOURCE=-1, in which case it is interpreted
204 ; as a CPU address.
205 7736 7726 tibh data warnh,3
205 7738 0003
206 773A 5449 text 'TIB '
206 773C 4220
207 773E 7740 tib_ data $+2
208 7740 0206 li r6,tibadr
208 7742 A1CE
209 7744 1008 jmp dovar
210 ;]
211
212 ;[ FFAIHM ( -- address )
213 ; returns the first free address in high memory
214 7746 7736 ffahh data tibh,6
214 7748 0006
215 774A 4646 text 'FFAIHM'
215 774C 4149
215 774E 484D
216 7750 7752 ffaih data $+2
217 7752 0206 li r6,ffaihm
217 7754 A01C
218 ; fall down into dovar...
219 ;]
220
221 ; DOVAR: common routine used by variables and constants to push their data onto
222 ; the stack. NOTE: this code is also used by code in Variables.a99
223 ; This code is placed here so that it falls within the 256 byte JMP limit of
224 ; both Constants.a99 and Variables.a99 - sneaky ;-)
225 7756 0644 dovar dect stack ; new stack entry
226 7758 C506 mov r6,*stack ; move value to data stack
227 775A 045C b *next
228
229 ;[ FFAILM ( -- address )
230 ; returns the first free address in low memory
231 775C 7746 ffalh data ffahh,6
231 775E 0006
232 7760 4646 text 'FFAILM'
232 7762 4149
232 7764 4C4D
233 7766 7768 ffaml data $+2
234 7768 0206 li r6,ffailm
234 776A A01A
235 776C 10F4 jmp dovar
236 ;]
237
238
239 ; _____ _ _
240 ; / ____| | | | |
241 ; | | ___ _ __ ___| |_ __ _ _ __ | |_ ___
242 ; | | / _ \| '_ \/ __| __|/ _` | '_ \| __/ __|
243 ; | |____| (_) | | | \__ \ |_| (_| | | | | |_\__ \
244 ; \_____|\___/|_| |_|___/\__|\__,_|_| |_|\__|___/
245
246 ;[ PAD -- addr 83
247 ; The lower address of a scratch area used to hold data for intermediate
248 ; processing.
249 ; The address or contents of PAD may change and the data lost if the address of
250 ; the next available dictionary location is changed.
251 ; The minimum capacity of PAD is 84 characters.
252 776E 775C padh data ffalh,3
252 7770 0003
253 7772 5041 text 'PAD '
253 7774 4420
254 7776 7778 pad data $+2
255 7778 C1A0 mov @ffaihm,r6 ; get first free address in HIGH memory
255 777A A01C
256 777C 0286 ci r6,>ffa8 ; compare to end of low memory-86 bytes
256 777E FFA8
257 7780 1102 jlt padx ; if less than then ok, just exit
258 ; otherwise, we're close to end of high memory, so...
259 7782 C1A0 mov @ffailm,r6 ; offer an address in low memory
259 7784 A01A
260 7786 0226 padx ai r6,80 ; add a margin
260 7788 0050
261 778A 10E5 jmp dovar
262 ;]
263
264 ;[ IOERR ( -- io_error ) (constant)
265 ; places last IO error code on the stack
266 778C 776E ioerrh data padh,5
266 778E 0005
267 7790 494F text 'IOERR '
267 7792 4552
267 7794 5220
268 7796 7798 ioerr1 data $+2
269 7798 C1A0 mov @errnum,r6
269 779A A038
270 779C 10DC jmp dovar
271 ;]
272
273 ;[ XMAX ( -- xmax ) (constant)
274 ; places the horizontal screen size (32, 40 or 80) on the stack
275 779E 778C xmaxh data ioerrh,4
275 77A0 0004
276 77A2 584D text 'XMAX'
276 77A4 4158
277 77A6 77A8 gxmax data $+2
278 77A8 C1A0 mov @xmax,r6
278 77AA A02C
279 77AC 10D4 jmp dovar
280 ;]
281
282 ;[ S0 ( -- address ) (constant)
283 ; *BEGINNING* address of data stack on data stack, used to reset the data stack
284 77AE 779E s0h data xmaxh,2
284 77B0 0002
285 77B2 5330 text 'S0'
286 77B4 77B6 s0_ data $+2
287 77B6 C1A0 mov @S0,r6 ; S0 defined in system.a99
287 77B8 A01E
288 77BA 10CD jmp dovar
289 ;]
290
291 ;[ HEX ( -- ) (function)
292 ; sets the number base to 16 decimal
293 77BC 77AE hexh data s0h,3
293 77BE 0003
294 77C0 4845 text 'HEX '
294 77C2 5820
295 77C4 77C6 hex data $+2
296 77C6 0200 li r0,16
296 77C8 0010
297 77CA C800 mov r0,@base
297 77CC A05C
298 77CE 045C b *next
299 ;]
300
301 ;[ DECIMAL ( -- ) (function)
302 ; sets the number base to 10 decimal
303 77D0 77BC dech data hexh,7
303 77D2 0007
304 77D4 4445 text 'DECIMAL '
304 77D6 4349
304 77D8 4D41
304 77DA 4C20
305 77DC 77DE deci data $+2
306 77DE 0200 li r0,10
306 77E0 000A
307 77E2 C800 mov r0,@base
307 77E4 A05C
308 77E6 045C b *next
309 ;]
310
311 ;[ TRUE ( -- flag ) (constant)
312 ; places TRUE (>FFFF) on the stack
313 77E8 77D0 trueh data dech,4
313 77EA 0004
314 77EC 5452 text 'TRUE'
314 77EE 5545
315 77F0 77F2 true data $+2
316 77F2 0706 seto r6
317 77F4 10B0 jmp dovar
318 ;]
319
320 ;[ FALSE ( -- flag ) (constant)
321 ; places FALSE (>0) on the stack
322 77F6 77E8 falseh data trueh,5
322 77F8 0005
323 77FA 4641 text 'FALSE '
323 77FC 4C53
323 77FE 4520
324 7800 7802 false data $+2
325 7802 04C6 clr r6
326 7804 10A8 jmp dovar
327 ;]
328
329 ;[ HERE ( -- addr ) (constant)
330 ; places the current compilation address on the stack
331 ; see the variable here (lower case) which allows the
332 ; current compilation address to be changed
333 7806 77F6 hhereh data falseh,4
333 7808 0004
334 780A 4845 text 'HERE'
334 780C 5245
335 780E 7810 ghere data $+2
336 7810 C1A0 mov @here,r6
336 7812 A046
337 7814 10A0 jmp dovar
338 ;]
339
340 ;[ RND ( limit -- n)
341 ; pushes a pseudo random number between 0 and limit-1 (rnd MOD limit)
342 ; For the full range (0-65535) use a limit of 0
343 7816 7806 rndh data hhereh,3
343 7818 0003
344 781A 524E text 'RND '
344 781C 4420
345 781E 7820 rnd data $+2
346 7820 06A0 bl @bank1
346 7822 8332
347 7824 6D42 data _rnd
348 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-15-Strings.a99'
*
1 ; _____ _ _ __ __ _
2 ; / ____| | (_) \ \ / / | |
3 ; | (___ | |_ _ __ _ _ __ __ _ \ \ /\ / /___ _ __ __| |___
4 ; \___ \| __| '__| | '_ \ / _` | \ \/ \/ // _ \| '__/ _` / __|
5 ; ____) | |_| | | | | | | (_| | \ /\ /| (_) | | | (_| \__ \
6 ; |_____/ \__|_| |_|_| |_|\__, | \/ \/ \___/|_| \__,_|___/
7 ; __/ |
8 ; |___/
9 ; string related words
10
11 ;[ U. u -- M,79 "u-dot"
12 ; u is displayed as an unsigned number in a free-field format.
13 7826 7816 udoth data rndh,2
13 7828 0002
14 782A 552E text 'U.'
15 782C 8320 udot data docol,usign,type,space1,exit
15 782E 78B4
15 7830 6C94
15 7832 6D38
15 7834 832C
16 ;]
17
18 ;[ . n -- M,79 "dot"
19 ; The absolute value of n is displayed in a free field format with a leading
20 ; minus sign if n is negative.
21 7836 7826 doth data udoth,1
21 7838 0001
22 783A 2E20 text '. '
23 783C 8320 dot data docol,sign
23 783E 78AC
24 7840 6C94 dot1 data type,space1,exit
24 7842 6D38
24 7844 832C
25 ;]
26
27 ;[ U.R ( num width -- )
28 7846 7836 udotrh data doth,3
28 7848 0003
29 784A 552E text 'U.R '
29 784C 5220
30 784E 8320 udotr data docol
31 7850 617C data swap \ width num
32 7852 78B4 data usign \ width addr len
33 7854 786C data setw \ addr len
34 7856 65E4 data branch,dot1
34 7858 7840
35 ;]
36
37 ;[ .R ( num width --)
38 785A 7846 dotrh data udotrh,2
38 785C 0002
39 785E 2E52 text '.R'
40 7860 8320 dotr data docol
41 7862 617C data swap \ width num
42 7864 78AC data sign \ width addr len
43 7866 786C data setw \ addr len
44 7868 65E4 data branch,dot1
44 786A 7840
45 ;]
46
47 ;[ subroutines used by . U. .R and U.R
48 786C 8320 setw data docol,rot,swap,tuck,sub,spces,exit
48 786E 6190
48 7870 617C
48 7872 61E0
48 7874 6326
48 7876 6D52
48 7878 832C
49 ;]
50
51 ;[ $. ( num -- )
52 ; prints a number as an unsigned hex value
53 787A 785A hdoth data dotrh,2
53 787C 0002
54 787E 242E text '$.'
55 7880 8320 hexdot data docol
56 7882 76FC data base_,fetch,swap
56 7884 6830
56 7886 617C
57 7888 77C4 data hex
58 788A 78B4 data usign,type
58 788C 6C94
59 788E 6D38 data space1
60 7890 76FC data base_,store,exit
60 7892 6852
60 7894 832C
61 ;]
62
63 ;[ N>S ( num -- addr len )
64 ; Takes a number off the stack and converts it to a signed string equivalent,
65 ; with respect to the current number base.
66 ; The variable UNSIGNED is checked, and if true, the strings generated shall be
67 ; the unsigned equivalents of the number on the stack, otherwise the string
68 ; shall be the signed equivalent of the number of the stack.
69 ;
70 ; sign and usign below are entry points into N>S for . and U. respectively to
71 ; force N>S to produce an appropriately signed string.
72 7896 787A ntsh data hdoth,3
72 7898 0003
73 789A 4E3E text 'N>S '
73 789C 5320
74 789E 78A0 nts data $+2
75 78A0 C820 mov @dotsin,@dosign ; set/reset signed/unsigned mode according to
75 78A2 A05A
75 78A4 A064
76 ; the Forth variable UNSIGNED
77 78A6 06A0 nts1 bl @bank1
77 78A8 8332
78 78AA 6DEC data _nts ; see 1-10-Strings.a99
79 ; entry points for . and U. :
80 78AC 78AE sign data $+2
81 78AE 04E0 clr @dosign
81 78B0 A064
82 78B2 10F9 jmp nts1
83 78B4 78B6 usign data $+2
84 78B6 0720 seto @dosign
84 78B8 A064
85 78BA 10F5 jmp nts1
86 ;]
87
88 ;[ CHAR ( -- ascii )
89 ; puts the ASCII code of the first character of the following word on the stack
90 ; For example CHAR A puts 65 on the stack.
91 78BC 7896 charh data ntsh,immed+4
91 78BE 8004
92 78C0 4348 text 'CHAR'
92 78C2 4152
93 78C4 8320 char data docol,spword,drop,chrftc,exit
93 78C6 72B2
93 78C8 6172
93 78CA 686E
93 78CC 832C
94 ;]
95
96 ;[ ASCII ( ascii -- )
97 ; In interpretation state:
98 ; pushes the ascii value of the character immediately following
99 ; ASCII to the stack.
100 ; In compilation state:
101 ; compiles the ascii value of the character immediately following
102 ; ASCII as a literal
103 78CE 78BC asciih data charh,immed+5
103 78D0 8005
104 78D2 4153 text 'ASCII '
104 78D4 4349
104 78D6 4920
105 78D8 8320 ascii data docol,char,state_,fetch,zbrnch,asciix
105 78DA 78C4
105 78DC 76CC
105 78DE 6830
105 78E0 65F6
105 78E2 78E6
106 78E4 60AC data clc ; compile lit ,
107 78E6 832C asciix data exit
108 ;]
109
110 ;[ COUNT addr1 -- addr2 +n 79
111 ; addr2 is addr1+1 and +n is the length of the counted string at addr1.
112 ; The byte at addr1 contains the byte count +n.
113 ; Range of +n is {0.255} See: "string, counted"
114 78E8 78CE counth data asciih,5
114 78EA 0005
115 78EC 434F text 'COUNT '
115 78EE 554E
115 78F0 5420
116 78F2 78F4 count data $+2
117 78F4 06A0 bl @bank1
117 78F6 8332
118 78F8 6D60 data _count ; see 1-10-Strings.a99
119 ;]
120
121 ;[ S" Compile time:( -- ) Immediate:( -- address length )
122 ; When Compiling:
123 ; compiles: (S")
124 ; e.g S" HELLO" compiles (S") 5 H E L L O
125 ; Note the 0 padding byte for odd length strings.
126 ; The length is a BYTE. At the end of string compilation, HERE is aligned to an
127 ; even address.
128 ; At run time, (S") pushes the address of the beginning of the string
129 ;(address of length byte+1) and the length to the stack.
130 ;
131 ; When Interpreting:
132 ; Compiles the string to the address PAD, and pushes the address and
133 ; length to the stack.
134 78FA 78E8 strngh data counth,immed+2
134 78FC 8002
135 78FE 5322 text 'S"'
136 7900 8320 string data docol,lit,34,word,pad,strng1,exit
136 7902 70B2
136 7904 0022
136 7906 6AA2
136 7908 7776
136 790A 790E
136 790C 832C
137 790E 7910 strng1 data $+2
138 7910 06A0 bl @bank1
138 7912 8332
139 7914 6D8C data _strin ; see 1-10-Strings.a99
140
141 ; (S") ( -- addr len )
142 ; internal string. S" compiles (S") into a word
143 ; At run time, (S") pushes the address and length of the string following it
144 ; to the stack.
145 7916 78FA strh data strngh,4
145 7918 0004
146 791A 2853 text '(S")'
146 791C 2229
147 791E 7920 str data $+2
148 7920 06A0 bl @bank1
148 7922 8332
149 7924 6DD2 data _str ; see 1-10-Strings.a99
150 ;]
151
152 ;[ -TRAILING addr +n1 -- addr +n2 79 "dash-trailing"
153 ; The character count +n1 of a text string beginning at addr is adjusted to
154 ; exclude trailing spaces.
155 ; If +n1 is zero, then +n2 is also zero.
156 ; If the entire string consists of spaces, then +n2 is zero.
157 7926 7916 trailh data strh,9
157 7928 0009
158 792A 2D54 text '-TRAILING '
158 792C 5241
158 792E 494C
158 7930 494E
158 7932 4720
159 7934 7936 trail data $+2
160 7936 06A0 bl @bank1
160 7938 8332
161 793A 6D6E data _trail ; see 1-10-Strings.a99
162 ;]
163
164 ;[ ." -- C,I,83 "dot-quote"
165 ; -- (compiling)
166 ; Used in the form:
167 ; ." ccc"
168 ; Later execution will display the characters ccc up to but not including the
169 ; delimiting " (close-quote). The blank following ." is not part of ccc.
170 793C 7926 tstrh data trailh,immed+2
170 793E 8002
171 7940 2E22 text '."'
172 7942 8320 typstr data docol
173 7944 7900 data string,state_,fetch,zbrnch,typst1,compile
173 7946 76CC
173 7948 6830
173 794A 65F6
173 794C 7950
173 794E 7262
174 7950 6C94 typst1 data type,exit
174 7952 832C
175
176
177
178
179 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-16-Graphics.a99'
*
1 ; _____ _ _ __ __ _
2 ; / ____| | | (_) \ \ / / | |
3 ; | | __ _ __ __ _ _ __ | |__ _ ___ ___ \ \ /\ / /___ _ __ __| |___
4 ; | | |_ | '__/ _` | '_ \| '_ \| |/ __/ __| \ \/ \/ // _ \| '__/ _` / __|
5 ; | |__| | | | (_| | |_) | | | | | (__\__ \ \ /\ /| (_) | | | (_| \__ \
6 ; \_____|_| \__,_| .__/|_| |_|_|\___|___/ \/ \/ \___/|_| \__,_|___/
7 ; | |
8 ; |_|
9 ; graphics related commands
10 ; the guts of these commands is in bank1 in 1-03-Graphics.a99
11
12 ;[ GMODE ( graphics_mode -- )
13 7954 793C gmodeh data tstrh,5
13 7956 0005
14 7958 474D text 'GMODE '
14 795A 4F44
14 795C 4520
15 795E 7960 gmode data $+2
16 7960 06A0 bl @bank1
16 7962 8332
17 7964 6192 data _gmode ; see 1-03-Graphics.a99
18 ;]
19
20 ;[ HCHAR ( y x ascii count -- )
21 7966 7954 hcharh data gmodeh,5
21 7968 0005
22 796A 4843 text 'HCHAR '
22 796C 4841
22 796E 5220
23 7970 7972 hchar data $+2
24 7972 06A0 bl @bank1
24 7974 8332
25 7976 6250 data _hchar ; see 1-03-Graphics.a99
26 ;]
27
28 ;[ VCHAR ( y x ascii count -- )
29 7978 7966 vcharh data hcharh,5
29 797A 0005
30 797C 5643 text 'VCHAR '
30 797E 4841
30 7980 5220
31 7982 7984 vchar data $+2
32 7984 06A0 bl @bank1
32 7986 8332
33 7988 625C data _vchar ; see 1-03-Graphics.a99
34 ;]
35
36 ;[ GCHAR ( y x -- ascii )
37 798A 7978 gcharh data vcharh,5
37 798C 0005
38 798E 4743 text 'GCHAR '
38 7990 4841
38 7992 5220
39 7994 7996 gchar data $+2
40 7996 06A0 bl @bank1
40 7998 8332
41 799A 6280 data _gchar ; see 1-03-Graphics.a99
42 ;]
43
44 ;[ DCHAR ( W1..Wx word_count ascii -- )
45 ; loads words from the stack into VDP memory at the ASCII
46 ; code specified. Equivalent to CALL CHAR in BASIC.
47 799C 798A dcharh data gcharh,5
47 799E 0005
48 79A0 4443 text 'DCHAR '
48 79A2 4841
48 79A4 5220
49 79A6 79A8 dchar data $+2
50 79A8 06A0 bl @bank1
50 79AA 8332
51 79AC 6298 data _dchar ; see 1-03-Graphics.a99
52 ;]
53
54 ;[ SPRITE ( sprite y x ascii color -- )
55 ; sprite attribute list begins at 6*80h=300h
56 79AE 799C sprith data dcharh,6
56 79B0 0006
57 79B2 5350 text 'SPRITE'
57 79B4 5249
57 79B6 5445
58 79B8 79BA sprite data $+2
59 79BA 06A0 bl @bank1
59 79BC 8332
60 79BE 62B4 data _sprit ; see 1-03-Graphics.a99
61 ;]
62
63 ;[ MAGNIFY ( x -- )
64 ; sets sprite magnification:
65 ; only the least significant bits are used:
66 ; bit 7: 1=magnified (0=not magnified)
67 ; bit 6: 1=double size (4 character)
68 ; Remember: TI number their bits backwards! Idiots!
69 79C0 79AE magfyh data sprith,7
69 79C2 0007
70 79C4 4D41 text 'MAGNIFY '
70 79C6 474E
70 79C8 4946
70 79CA 5920
71 79CC 79CE magfy data $+2
72 79CE 06A0 bl @bank1
72 79D0 8332
73 79D2 62E4 data _magfy ; see 1-03-Graphics.a99
74 ;]
75
76 ;[ SPRCOL ( sprite colour -- )
77 ; sets the colour of a sprite
78 79D4 79C0 sprclh data magfyh,6
78 79D6 0006
79 79D8 5350 text 'SPRCOL'
79 79DA 5243
79 79DC 4F4C
80 79DE 79E0 sprcol data $+2
81 79E0 06A0 bl @bank1
81 79E2 8332
82 79E4 630E data _spcol ; see 1-03-Graphics.a99
83 ;]
84
85 ;[ SPRLOC ( sprite y x -- )
86 ; sets the location of a sprite
87 79E6 79D4 sprlch data sprclh,6
87 79E8 0006
88 79EA 5350 text 'SPRLOC'
88 79EC 524C
88 79EE 4F43
89 79F0 79F2 sprloc data $+2
90 79F2 06A0 bl @bank1
90 79F4 8332
91 79F6 632C data _sploc ; see 1-03-Graphics.a99
92 ;]
93
94 ;[ SPRLOC? ( sprite -- y x )
95 ; gets the location of a sprite
96 79F8 79E6 locsph data sprlch,7
96 79FA 0007
97 79FC 5350 text 'SPRLOC? '
97 79FE 524C
97 7A00 4F43
97 7A02 3F20
98 7A04 7A06 locspr data $+2
99 7A06 06A0 bl @bank1
99 7A08 8332
100 7A0A 6352 data _spget ; see 1-03-Graphics.a99
101 ;]
102
103 ;[ SPRPAT ( sprite ascii -- )
104 ; sets the pattern of a sprite
105 7A0C 79F8 sppath data locsph,6
105 7A0E 0006
106 7A10 5350 text 'SPRPAT'
106 7A12 5250
106 7A14 4154
107 7A16 7A18 sprpat data $+2
108 7A18 06A0 bl @bank1
108 7A1A 8332
109 7A1C 6370 data _sppat ; see 1-03-Graphics.a99
110 ;]
111
112 ;[ SPRVEC ( sprite y x -- )
113 ; sets the Y and X movement vectors for sprite movement with SPRMOV
114 7A1E 7A0C smlsth data sppath,6
114 7A20 0006
115 7A22 5350 text 'SPRVEC'
115 7A24 5256
115 7A26 4543
116 7A28 7A2A smlst data $+2
117 7A2A 06A0 bl @bank1
117 7A2C 8332
118 7A2E 638E data _smlst ; see 1-03-Graphics.a99
119 ;]
120
121 ;[ SPRMOV ( start_sprite number_of_sprites -- )
122 ; moves sprites according to the entries in SMLIST, starting from start_sprite
123 ; and continuing for number_of_sprites
124 7A30 7A1E sprmvh data smlsth,6
124 7A32 0006
125 7A34 5350 text 'SPRMOV'
125 7A36 524D
125 7A38 4F56
126 7A3A 7A3C sprmov data $+2
127 7A3C 06A0 bl @bank1
127 7A3E 8332
128 7A40 63A4 data _spmov ; see 1-03-Graphics.a99
129 ;]
130
131 ;[ COLOR ( char_set foreground background -- )
132 ; sets the color sets in 32 column mode
133 7A42 7A30 colorh data sprmvh,5
133 7A44 0005
134 7A46 434F text 'COLOR '
134 7A48 4C4F
134 7A4A 5220
135 7A4C 7A4E color data $+2
136 7A4E 06A0 bl @bank1
136 7A50 8332
137 7A52 63DE data _color ; see 1-03-Graphics.a99
138 ;]
139
140 ;[ SCREEN ( colour -- )
141 ; sets the screen colour
142 7A54 7A42 scrnh data colorh,6
142 7A56 0006
143 7A58 5343 text 'SCREEN'
143 7A5A 5245
143 7A5C 454E
144 7A5E 7A60 screen data $+2
145 7A60 06A0 bl @bank1
145 7A62 8332
146 7A64 63F8 data _scren ; see 1-03-Graphics.a99
147 ;]
148
149 ;[ SCROLL ( direction -- )
150 ; scrolls the panel defined by PANEL in the direction specified
151 ; 0=left 1=right 2=up 3=down
152 7A66 7A54 scrolh data scrnh,6
152 7A68 0006
153 7A6A 5343 text 'SCROLL'
153 7A6C 524F
153 7A6E 4C4C
154 7A70 7A72 scroll data $+2
155 7A72 06A0 bl @bank1
155 7A74 8332
156 7A76 640A data _scrol ; see 1-03-Graphics.a99
157 ;]
158
159 ;[ PANEL ( x y xl yl -- )
160 ; defines a screen area to be scrolled by SCROLL
161 7A78 7A66 panelh data scrolh,5
161 7A7A 0005
162 7A7C 5041 text 'PANEL '
162 7A7E 4E45
162 7A80 4C20
163 7A82 7A84 panel data $+2
164 7A84 06A0 bl @bank1
164 7A86 8332
165 7A88 656C data _panel ; see 1-03-Graphics.a99
166 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-17-Speech.a99'
*
1 ; _____ _ __ __ _
2 ; / ____| | | \ \ / / | |
3 ; | (___ _ __ ___ ___ ___| |__ \ \ /\ / /___ _ __ __| |___
4 ; \___ \| '_ \ / _ \/ _ \/ __| '_ \ \ \/ \/ // _ \| '__/ _` / __|
5 ; ____) | |_) | __/ __/ (__| | | | \ /\ /| (_) | | | (_| \__ \
6 ; |_____/| .__/ \___|\___|\___|_| |_| \/ \/ \___/|_| \__,_|___/
7 ; | |
8 ; |_|
9
10 ; these routines are just dictionary entry stubs.
11 ; see 1-04-Speech.a99 for the actual implementation.
12
13 ;[ TALKING? ( -- flag )
14 ; returns >0 if the speech synth is busy, else returns 0
15 7A8A 7A78 spkngh data panelh,8
15 7A8C 0008
16 7A8E 5441 text 'TALKING?'
16 7A90 4C4B
16 7A92 494E
16 7A94 473F
17 7A96 7A98 spkng data $+2
18 7A98 06A0 bl @bank1
18 7A9A 8332
19 7A9C 662C data _spkng ; see 1-05-Speech.a99
20 ;]
21
22 ;[ SAY ( addr cnt -- )
23 ; says words from the speech synth's ROM. Use with DATA
24 ; the addresses of the built in words are in ED/AS manual page 422
25 7A9E 7A8A sayh data spkngh,3
25 7AA0 0003
26 7AA2 5341 text 'SAY '
26 7AA4 5920
27 7AA6 7AA8 say data $+2
28 7AA8 06A0 bl @bank1
28 7AAA 8332
29 7AAC 664E data _say ; see 1-05-Speech.a99
30 ;]
31
32 ;[ STREAM ( addr cnt -- )
33 ; streams raw speech data to the speech synth. Use with DATA
34 7AAE 7A9E strmh data sayh,6
34 7AB0 0006
35 7AB2 5354 text 'STREAM'
35 7AB4 5245
35 7AB6 414D
36 7AB8 7ABA strm data $+2
37 7ABA 06A0 bl @bank1
37 7ABC 8332
38 7ABE 6668 data _strem ; see 1-05-Speech.a99
39 ;]
40
41 ;[ DATA
42 ; Compiling: DATA ( -- ) Executing: DATA ( -- addr count )
43 ; E.g.
44 ; When compiling:
45 ; DATA 5 9 8 7 6 5
46 ; Compiles 5 values (9 8 7 6 & 5) to memory
47 ; At runtime:
48 ; When DATA is encountered, will push the start address (the address of 9)
49 ; to the stack, and the count (5). Execution will continue at the word
50 ; immediately following the data list.
51 7AC0 7AAE datah data strmh,immed+4
51 7AC2 8004
52 7AC4 4441 text 'DATA'
52 7AC6 5441
53 7AC8 8320 data docol
54 7ACA 7262 data compile,rtdata ; compile data run-time code
54 7ACC 7AF6
55 7ACE 72B2 data spword,number,drop ; get number of data items from input stream
55 7AD0 6B76
55 7AD2 6172
56 7AD4 6186 data dup,comma ; and append to definition
56 7AD6 70CC
57
58 7AD8 6084 data lit0,do,data2 ; for each data item
58 7ADA 66F6
58 7ADC 7AEA
59 7ADE 72B2 data1 data spword,number,drop ; get number from input stream
59 7AE0 6B76
59 7AE2 6172
60 7AE4 70CC data comma ; append directly to memory
61 7AE6 673E data loop,data1
61 7AE8 7ADE
62 7AEA 832C data2 data exit
63
64 ; (DATA) - run-time code for DATA
65 7AEC 7AC0 rtdath data datah,6
65 7AEE 0006
66 7AF0 2844 text '(DATA)'
66 7AF2 4154
66 7AF4 4129
67 7AF6 7AF8 rtdata data $+2
68 7AF8 06A0 bl @bank1
68 7AFA 8332
69 7AFC 66D6 data _data ; see 1-05-Speech.a99
70 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-18-Blocks.a99'
*
1 ; ____ _ _ _____ ______ __ __ _
2 ; | _ \| | | | |_ _| / / __ \ \ \ / / | |
3 ; | |_) | | ___ ___| | __ | | / / | | | \ \ /\ / /___ _ __ __| |___
4 ; | _ <| |/ _ \ / __| |/ / | | / /| | | | \ \/ \/ // _ \| '__/ _` / __|
5 ; | |_) | | (_) | (__| < _| |_ / / | |__| | \ /\ /| (_) | | | (_| \__ \
6 ; |____/|_|\___/ \___|_|\_\ |_____/_/ \____/ \/ \/ \___/|_| \__,_|___/
7 ; block file system words & subroutines
8
9 ; Notes:
10 ; Since File IO on the TI takes place in VDP RAM, the block system is
11 ; implemented using VDP ram to hold the blocks. In other words, blocks live
12 ; in VDP RAM, *not* CPU ram. Might as well use VDP for something and it has
13 ; the added benefit of leaving *lots* more CPU ram available for Forth code.
14 ;
15 ; The 'system' is designed to support up to six blocks in VDP ram at once.
16 ; I.e. there are six 1K buffers in VDP, each buffer can hold any block.
17 ; The buffers are allocated in sequential order until they are used. When no
18 ; more buffers are available, a previously used buffer is used, it's contents
19 ; are overwritten. However, *if* the contents of a block have been changed
20 ; (i.e. they are more up-to-date than the copy on the disk) the block is
21 ; automatically flushed back to disk before being re-used.
22 ;
23 ; The VDP addresses of the block buffers are defined in 1-15-Initialise.a99
24 ;
25
26 ;[ USE ( addr len -- )
27 ; Tells the system which block file to use for block IO
28 ; e.g. S" DSK1.BLOCKS" USE
29 ; Simply sets the filename and length in the blockIO PAB
30 7AFE 7AEC useh data rtdath,3
30 7B00 0003
31 7B02 5553 text 'USE '
31 7B04 4520
32 7B06 8320 use data docol,mtbuf,use1,exit
32 7B08 7CB2
32 7B0A 7B0E
32 7B0C 832C
33 7B0E 7B10 use1 data $+2
34 7B10 06A0 bl @bank1
34 7B12 8332
35 7B14 66EA data _use ; see 1-06-Blocks.a99
36 ;]
37
38 ;[ WHERE ( -- block# )
39 ; returns the block number of word that has been loaded into memory with LOAD
40 ; eg: WHERE FOO
41 ; can only be used from the command line
42 ; returns 0 if not found, or if the word is in ROM
43 7B16 7AFE whereh data useh,immed+5
43 7B18 8005
44 7B1A 5748 text 'WHERE '
44 7B1C 4552
44 7B1E 4520
45 7B20 8320 where data docol,spword,find,zbrnch,where1
45 7B22 72B2
45 7B24 6AD8
45 7B26 65F6
45 7B28 7B40
46 7B2A 6C1E data dfa,plus2,fetch,lit,4,rsft,lit,>3ff,and,plus1,exit
46 7B2C 62CE
46 7B2E 6830
46 7B30 70B2
46 7B32 0004
46 7B34 681E
46 7B36 70B2
46 7B38 03FF
46 7B3A 67D2
46 7B3C 62BA
46 7B3E 832C
47 7B40 6172 where1 data drop,lit0,exit
47 7B42 6084
47 7B44 832C
48 ;]
49
50 ;[ BLK -- addr U,79 "b-l-k"
51 ; The address of a variable containing the number of the mass storage block
52 ; being interpreted as the input stream.
53 ; If the value of BLK is zero the input stream is taken from the text input
54 ; buffer. {{0..the number of blocks available -1}}
55 ; See: TIB "input stream"
56 7B46 7B16 blkh data whereh,3
56 7B48 0003
57 7B4A 424C text 'BLK '
57 7B4C 4B20
58 7B4E 7B50 blk data $+2
59 7B50 0206 li r6,blknum ; address of block variable in ram
59 7B52 A1B2
60 7B54 0460 b @dovar ; push it
60 7B56 7756
61 ;]
62
63 ;[ --> ( -- )
64 ; loads the next block
65 7B58 7B46 nblkh data blkh,immed+3
65 7B5A 8003
66 7B5C 2D2D text '--> '
66 7B5E 3E20
67 7B60 8320 nblk data docol
68 7B62 7B4E data blk,fetch,plus1,blk,store,in_,store0
68 7B64 6830
68 7B66 62BA
68 7B68 7B4E
68 7B6A 6852
68 7B6C 770C
68 7B6E 6892
69 7B70 832C data exit
70 ;]
71
72 ;[ THRU ( start end -- )
73 ; loads blocks start thru end inclusive by calling LOAD for each block.
74 7B72 7B58 thruh data nblkh,4
74 7B74 0004
75 7B76 5448 text 'THRU'
75 7B78 5255
76 7B7A 8320 thru data docol,plus1,swap
76 7B7C 62BA
76 7B7E 617C
77 7B80 66F6 data do,xthru
77 7B82 7B8C
78 7B84 679A thrulp data geti,load
78 7B86 7C18
79 7B88 673E data loop,thrulp
79 7B8A 7B84
80 7B8C 832C xthru data exit
81 ; : THRU ( start-block end-block -- ) 1+ SWAP DO I LOAD LOOP ;
82 ;]
83
84 ;[ BLOCK u -- vdpaddr M,83
85 ; addr is the address of the assigned buffer of the first byte of block u.
86 ; If the block occupying that buffer is not block u and has been UPDATEed it is
87 ; transferred to mass storage before assigning the buffer.
88 ; If block u is not already in memory, it is transferred from mass storage into
89 ; an assigned block buffer. A block may not be assigned to more than one
90 ; buffer.
91 ; If u is not an available block number, an error condition exists.
92 ; Only data within the last buffer referenced by BLOCK or BUFFER is valid.
93 ; The contents of a block buffer must not be changed unless the change may be
94 ; transferred to mass storage.BLOCK ( block# -- addr )
95 ;
96 ; Brings a block into a buffer, if not already in memory
97 ; 1) If already in memory, the block is not re-loaded from device
98 ; 2) If not in memory:
99 ; 3) Scans for a free buffer
100 ; 4) If no free buffer:
101 ; 5) flush all buffers back to device
102 ; 6) Repeat from 3
103 ; 7) If free buffer:
104 ; 9) Load block from device into free buffer
105 ; 10) Return address of buffer
106 ; 11) If disk error, or block not found etc, return 0
107 7B8E 7B72 blockh data thruh,5
107 7B90 0005
108 7B92 424C text 'BLOCK '
108 7B94 4F43
108 7B96 4B20
109 7B98 8320 block data docol,lit,blkvec,fetch,execut,exit
109 7B9A 70B2
109 7B9C A002
109 7B9E 6830
109 7BA0 72AA
109 7BA2 832C
110 7BA4 7BA6 block2 data $+2
111 7BA6 06A0 bl @bank1
111 7BA8 8332
112 7BAA 671E data _block ; see 1-06-Blocks.a99
113 ;]
114
115 ;[ LIST ( block# -- )
116 ; lists a blocks' contents to the screen without loading it
117 7BAC 7B8E listh data blockh,4
117 7BAE 0004
118 7BB0 4C49 text 'LIST'
118 7BB2 5354
119 7BB4 8320 list_ data docol,fblock,dup,zbrnch,lstxit
119 7BB6 7C52
119 7BB8 6186
119 7BBA 65F6
119 7BBC 7BF8
120 7BBE 70B2 data lit,16,lit0
120 7BC0 0010
120 7BC2 6084
121 7BC4 66F6 data do,lstxit
121 7BC6 7BF8
122 7BC8 6E92 list1 data cr,geti,lit,2,dotr
122 7BCA 679A
122 7BCC 70B2
122 7BCE 0002
122 7BD0 7860
123 7BD2 70B2 data lit,3,emit,dup,ghere,lit,64,fvmbr,ghere
123 7BD4 0003
123 7BD6 6D98
123 7BD8 6186
123 7BDA 780E
123 7BDC 70B2
123 7BDE 0040
123 7BE0 6902
123 7BE2 780E
124 7BE4 70B2 data lit,64,trail,type,lit,64,add,break
124 7BE6 0040
124 7BE8 7934
124 7BEA 6C94
124 7BEC 70B2
124 7BEE 0040
124 7BF0 631E
124 7BF2 6C54
125 7BF4 673E data loop,list1
125 7BF6 7BC8
126 7BF8 6172 lstxit data drop,cr,blk,store0,span,fetch,in_,store
126 7BFA 6E92
126 7BFC 7B4E
126 7BFE 6892
126 7C00 7658
126 7C02 6830
126 7C04 770C
126 7C06 6852
127 7C08 70B2 data lit,lstblk,store0,exit
127 7C0A A1B4
127 7C0C 6892
127 7C0E 832C
128 ;]
129
130 ;[ LOAD ( block# -- )
131 ; interprets a block
132 7C10 7BAC loadh data listh,4
132 7C12 0004
133 7C14 4C4F text 'LOAD'
133 7C16 4144
134 7C18 8320 load data docol
135 7C1A 770C data in_,fetch,rspush
135 7C1C 6830
135 7C1E 6290
136 7C20 7B4E data blk,fetch,rspush
136 7C22 6830
136 7C24 6290
137 7C26 7658 data span,fetch,rspush
137 7C28 6830
137 7C2A 6290
138 7C2C 70B2 data lit,1024,span,store
138 7C2E 0400
138 7C30 7658
138 7C32 6852
139 7C34 770C data in_,store0
139 7C36 6892
140 7C38 7B4E data blk,store
140 7C3A 6852
141 7C3C 72FE data interp
142 7C3E 62AC data rspop,span,store
142 7C40 7658
142 7C42 6852
143 7C44 62AC data rspop,blk,store
143 7C46 7B4E
143 7C48 6852
144 7C4A 62AC data rspop,in_,store
144 7C4C 770C
144 7C4E 6852
145 7C50 832C data exit
146 ;]
147
148 fblock ; ( blk# --)
149 ; fetch block and strip off dirty bit
150 7C52 8320 data docol,block,lit,>7fff,and,exit
150 7C54 7B98
150 7C56 70B2
150 7C58 7FFF
150 7C5A 67D2
150 7C5C 832C
151
152 ;[ CLOAD ( blk -- )
153 ; Conditionally loads a block if the referenced word (passed in the TIB) is
154 ; not found.
155 ; e.g. 69 CLOAD SAMS? will load block 69 if the word SAMS? is not found.
156 ; If the word *is* found then no further action is taken.
157 7C5E 7C10 cloadh data loadh,immed+5
157 7C60 8005
158 7C62 434C text 'CLOAD '
158 7C64 4F41
158 7C66 4420
159 7C68 8320 cload data docol,spword,find,nip
159 7C6A 72B2
159 7C6C 6AD8
159 7C6E 61D2
160 7C70 65F6 data zbrnch,cload1
160 7C72 7C78
161 7C74 6172 data drop,exit
161 7C76 832C
162 7C78 7C18 cload1 data load,exit
162 7C7A 832C
163 ;]
164
165 ;[ UPDATE -- 79
166 ; The currently valid block buffer is marked as modified.
167 ; Blocks marked as modified will subsequently be automatically transferred to
168 ; mass storage should its memory buffer be needed for storage of a different
169 ; block or upon execution of FLUSH.
170 7C7C 7C5E updath data cloadh,6
170 7C7E 0006
171 7C80 5550 text 'UPDATE'
171 7C82 4441
171 7C84 5445
172 7C86 7C88 update data $+2
173 7C88 06A0 bl @bank1
173 7C8A 8332
174 7C8C 6840 data _updat ; see 1-06-Blocks.a99
175 ;]
176
177 ;[ FLUSH -- M,83
178 ; Flushes all modified buffers to the storage device then unassigns all block
179 ; buffers.
180 7C8E 7C7C flushh data updath,5
180 7C90 0005
181 7C92 464C text 'FLUSH '
181 7C94 5553
181 7C96 4820
182 7C98 7C9A flush data $+2
183 7C9A 06A0 bl @bank1
183 7C9C 8332
184 7C9E 67AE data _flush ; see 1-06-Blocks.a99
185 ;]
186
187 ;[ EMPTY-BUFFERS ( -- )
188 ; immediately sets all buffers to unsaasigned.
189 ; DOES NOT flush dirty buffers to disk
190 7CA0 7C8E mtbufh data flushh,13
190 7CA2 000D
191 7CA4 454D text 'EMPTY-BUFFERS '
191 7CA6 5054
191 7CA8 592D
191 7CAA 4255
191 7CAC 4646
191 7CAE 4552
191 7CB0 5320
192 7CB2 7CB4 mtbuf data $+2
193 7CB4 06A0 bl @bank1
193 7CB6 8332
194 7CB8 6854 data _mtbuf ; see 1-06-Blocks.a99
195 ;]
196
197 ;[ CLEAN ( buffer -- )
198 ; forces a buffers' status to clean
199 7CBA 7CA0 cleanh data mtbufh,5
199 7CBC 0005
200 7CBE 434C text 'CLEAN '
200 7CC0 4541
200 7CC2 4E20
201 7CC4 7CC6 bclean data $+2
202 7CC6 06A0 bl @bank1
202 7CC8 8332
203 7CCA 6870 data _clean ; see 1-06-Blocks.a99
204 ;]
205
206 ;[ DIRTY ( buffer -- )
207 ; forces a buffers' status to dirty
208 7CCC 7CBA dirtyh data cleanh,5
208 7CCE 0005
209 7CD0 4449 text 'DIRTY '
209 7CD2 5254
209 7CD4 5920
210 7CD6 7CD8 dirty data $+2
211 7CD8 06A0 bl @bank1
211 7CDA 8332
212 7CDC 687C data _dirty ; see 1-06-Blocks.a99
213 ;]
214
215 ;[ DIRTY? ( buffer -- flag )
216 ; interrogates a buffers' status, returning true if the buffer is dirty, else
217 ; returning false
218 7CDE 7CCC dirtih data dirtyh,6
218 7CE0 0006
219 7CE2 4449 text 'DIRTY?'
219 7CE4 5254
219 7CE6 593F
220 7CE8 7CEA dirtyq data $+2
221 7CEA 06A0 bl @bank1
221 7CEC 8332
222 7CEE 6888 data _qdirt ; see 1-06-Blocks.a99
223 ;]
224
225 ;[ BLK? ( buffer -- block vdp_address )
226 ; For a given buffer, returns the actual block stored in that buffer
227 ; and the vdp address of that buffer
228 7CF0 7CDE blkqh data dirtih,4
228 7CF2 0004
229 7CF4 424C text 'BLK?'
229 7CF6 4B3F
230 7CF8 7CFA blkq data $+2
231 7CFA 06A0 bl @bank1
231 7CFC 8332
232 7CFE 689E data _blkq ; see 1-06-Blocks.a99
233 ;]
234
235 ;[ BUF? ( block -- buffer vdp_address )
236 ; For a given block, return the buffer number, and the vdp address of the buffer
237 ; returns 0 0 if the block is not in memory
238 7D00 7CF0 bufh data blkqh,4
238 7D02 0004
239 7D04 4255 text 'BUF?'
239 7D06 463F
240 7D08 7D0A buf data $+2
241 7D0A 06A0 bl @bank1
241 7D0C 8332
242 7D0E 68B2 data _buf ; see 1-06-Blocks.a99
243 ;]
244
245 ;[ SETBLK ( buffer block -- )
246 ; For a given buffer, changes the block that it is associated with.
247 ; Allows blocks to copied to other blocks, using FLUSH.
248 ; Blocks can also be copied to a different block file by changing the blocks
249 ; file (with USE) before using FLUSH.
250 7D10 7D00 setblh data bufh,6
250 7D12 0006
251 7D14 5345 text 'SETBLK'
251 7D16 5442
251 7D18 4C4B
252 7D1A 7D1C setblk data $+2
253 7D1C 06A0 bl @bank1
253 7D1E 8332
254 7D20 68E0 data _setbk ; see 1-06-Blocks.a99
255 ;]
256
257 ;[ MKBLK ( block_count -- )
258 ; makes a block file on disk.
259 ; E.G. 80 MKBLOCK DSK1.BLOCKS
260 ; The above creates an 80K file on disk 1 called BLOCKS.
261 ; use IOERR to check success.
262 ; IOERR contains 0 for success or the disk error code
263 7D22 7D10 mkblkh data setblh,immed+5
263 7D24 8005
264 7D26 4D4B text 'MKBLK '
264 7D28 424C
264 7D2A 4B20
265 7D2C 8320 mkblk data docol
266 7D2E 72B2 data spword ; get the filename
267 7D30 7D34 data mkblkc,exit ; branch to bank 1
267 7D32 832C
268 7D34 7D36 mkblkc data $+2
269 7D36 06A0 bl @bank1
269 7D38 8332
270 7D3A 68F0 data _mkblk ; see 1-06-Blocks.a99
271 ;]
272
273 ; WriteHeader ( vdp_addr -- vdp_addr+8)
274 ; : WRITE-HEADER ( vdp_addr -- vdp_addr+8)
275 ; $994A VW! LATEST @ VW! HERE VW! 3 PICK VW! ;
276 7D3C 8320 whead data docol
277 7D3E 70B2 data lit,>994a,vdpww,lates_,fetch,vdpww,ghere,vdpww,lit,3,pick,vdpww
277 7D40 994A
277 7D42 7D58
277 7D44 76DE
277 7D46 6830
277 7D48 7D58
277 7D4A 780E
277 7D4C 7D58
277 7D4E 70B2
277 7D50 0003
277 7D52 6212
277 7D54 7D58
278 7D56 832C data exit
279
280 7D58 8320 vdpww data docol ; V2! ( addr val -- addr+2 )
281 7D5A 6220 data swpb_,swap,dup,nrot,dup2,vdpstr,plus1,swap,swpb_,swap,vdpstr,plus2
281 7D5C 617C
281 7D5E 6186
281 7D60 61AC
281 7D62 75EE
281 7D64 68C0
281 7D66 62BA
281 7D68 617C
281 7D6A 6220
281 7D6C 617C
281 7D6E 68C0
281 7D70 62CE
282 7D72 832C data exit
283
284
285 ; BSAVE ( start_address start_block -- first_free_block)
286 ; : BSAVE ( addr block - next_free_block)
287 ; OVER HERE SWAP -
288 ; BEGIN DUP 1008 > WHILE
289 ; OVER GBASD
290 ; WRITE-HEADER
291 ; 3 PICK 1008 VMBW
292 ; 1008 - ROT 1008 + -ROT SWAP 1+ SWAP
293 ; REPEAT
294 ; SWAP DUP GBASD WRITE-HEADER 3 PICK 3 PICK VMBW
295 ; 1+ NIP NIP FLUSH ;
296 7D74 7D22 bsaveh data mkblkh,5
296 7D76 0005
297 7D78 4253 text 'BSAVE '
297 7D7A 4156
297 7D7C 4520
298 7D7E 8320 bsave data docol
299 7D80 61C8 data over,ghere,swap,sub
299 7D82 780E
299 7D84 617C
299 7D86 6326
300 7D88 6186 bsave1 data dup,lit,1008,gt,zbrnch,bsave2
300 7D8A 70B2
300 7D8C 03F0
300 7D8E 6488
300 7D90 65F6
300 7D92 7DC2
301 7D94 61C8 data over,block,update
301 7D96 7B98
301 7D98 7C86
302 7D9A 7D3C data whead
303 7D9C 70B2 data lit,3,pick,lit,1008,fvmbw
303 7D9E 0003
303 7DA0 6212
303 7DA2 70B2
303 7DA4 03F0
303 7DA6 6912
304 7DA8 70B2 data lit,1008,sub,rot,lit,1008,add,nrot,swap,plus1,swap
304 7DAA 03F0
304 7DAC 6326
304 7DAE 6190
304 7DB0 70B2
304 7DB2 03F0
304 7DB4 631E
304 7DB6 61AC
304 7DB8 617C
304 7DBA 62BA
304 7DBC 617C
305 7DBE 65E4 data branch,bsave1
305 7DC0 7D88
306 7DC2 617C bsave2 data swap,dup,block,update,whead,lit,3,pick,lit,3,pick,fvmbw
306 7DC4 6186
306 7DC6 7B98
306 7DC8 7C86
306 7DCA 7D3C
306 7DCC 70B2
306 7DCE 0003
306 7DD0 6212
306 7DD2 70B2
306 7DD4 0003
306 7DD6 6212
306 7DD8 6912
307 7DDA 62BA data plus1,nip,nip,flush
307 7DDC 61D2
307 7DDE 61D2
307 7DE0 7C98
308 7DE2 832C data exit
309
310
311 ; BLOAD ( start_block -- )
312 ; : BLOAD ( block -- next_free_block)
313 ; BEGIN DUP BLOCK DUP VW@ $994A = WHILE
314 ; 2+ DUP VW@ LATEST ! 2+ DUP VW@ H ! 2+ DUP VW@ SWAP 2+ SWAP
315 ; 1008 VMBR 1+
316 ; REPEAT DROP ;
317 7DE4 7D74 bloadh data bsaveh,5
317 7DE6 0005
318 7DE8 424C text 'BLOAD '
318 7DEA 4F41
318 7DEC 4420
319 7DEE 8320 data docol
320 7DF0 6186 bload1 data dup,fblock,dup,vdprw,lit,>994a,eq,zbrnch,bload2
320 7DF2 7C52
320 7DF4 6186
320 7DF6 68E8
320 7DF8 70B2
320 7DFA 994A
320 7DFC 647A
320 7DFE 65F6
320 7E00 7E2E
321 7E02 62CE data plus2,dup,vdprw,lates_,store
321 7E04 6186
321 7E06 68E8
321 7E08 76DE
321 7E0A 6852
322 7E0C 62CE data plus2,dup,vdprw,here_,store
322 7E0E 6186
322 7E10 68E8
322 7E12 76EC
322 7E14 6852
323 7E16 62CE data plus2,dup,vdprw,swap,plus2,swap
323 7E18 6186
323 7E1A 68E8
323 7E1C 617C
323 7E1E 62CE
323 7E20 617C
324 7E22 70B2 data lit,1008,fvmbr,plus1
324 7E24 03F0
324 7E26 6902
324 7E28 62BA
325 7E2A 65E4 data branch,bload1
325 7E2C 7DF0
326 7E2E 6172 bload2 data drop
327 7E30 7E34 data memptr ; adjust ffaihm & ffailm as appropriate
328 7E32 832C data exit
329 7E34 7E36 memptr data $+2
330 7E36 C020 mov @here,r0
330 7E38 A046
331 7E3A 06A0 bl @bank1
331 7E3C 8332
332 7E3E 6CDA data mpadj ; see 1-09-Compilation.a99
333 7E40 045C b *next
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-19-File-IO.a99'
*
1 ; ______ _ _ _____ ______
2 ; | ____(_) | |_ _| / / __ \
3 ; | |__ _| | ___ | | / / | | |
4 ; | __| | | |/ _ \ | | / /| | | |
5 ; | | | | | __/ _| |_ / / | |__| |
6 ; |_| |_|_|\___| |_____/_/ \____/
7 ; File IO implementation
8
9 ;[ FILE ( s_addr s_len buf_addr -- )
10 ; Builds a PAB in the buffer whose address is passed as buf_addr using the data
11 ; in the string represented by s_addr and s_len.
12 ; For example:
13 ; FBUF: PRINTER
14 ; S" PIO.CR DV80O" PRINTER FILE
15 ; The above builds a PAB in the buffer called PRINTER which references the PIO
16 ; device. Subsequent file IO words that wish to send data to the PIO shall use
17 ; the buffer name to reference it:
18 ; e.g.
19 ; PRINTER #OPEN DROP ( open PIO and drop success/fail flag)
20 ; S" HELLO WORLD" PRINTER #PUT DROP
21 ; ( write HELLO WORLD to the PIO and drop success/fail flag)
22 ;
23 ; Internally, FILE builds a PAB in the buffer which will be used by #OPEN and
24 ; all file IO words.
25 ; Word 0 of the reserved memory is used to point to the actual PAB in VDP
26 ; memory.
27 ; Enough space should be reserved (with ALLOT) in the buffer to hold the PAB
28 ; and the filename.
29 ;
30 ; The string which specifies the file name and file characteristics is defined
31 ; as below.
32 ; The filename *must* come first followed by a space character.
33 ; After that, the file options can be specified in any order.
34 ;
35 ; File Options:
36 ; F=Fixed - Fixed record type
37 ; V=Variable - Variable record type
38 ;
39 ; D=Display - Display data type
40 ; L=InternaL - Internal data type
41 ;
42 ; U=Update - Update file mode
43 ; O=Output - Output file mode
44 ; I=Input - Inoput file mode
45 ; A=Append - Append file mode
46 ;
47 ; S=Sequential - Sequential file type
48 ; R=Relative - Relative file type
49 ;
50 ; Note that Internal type files require L - this is because I is used to
51 ; specify INPUT
52 7E42 7DE4 fileh data bloadh,4
52 7E44 0004
53 7E46 4649 text 'FILE'
53 7E48 4C45
54 7E4A 7E4C file1 data $+2
55 7E4C 06A0 bl @bank1
55 7E4E 8332
56 7E50 78FA data _file ; see 1-14-File-IO.a99
57 ;]
58
59 ;[ FBUF: ( -- )
60 ; builds a buffer with the name given for use with File IO.
61 ; The buffer is used to hold the PAB during construction by FILE.
62 ; e.g. FBUF: MYFILE
63 ; creates a 42 byte buffer for holding a PAB.
64 ; MYFILE becomes a word in the dictionary which, when executed, returns the
65 ; address of the start of the buffer.
66 ; The buffer is supplied as an input to the file IO words. E.g.
67 ; FBUF: DV80 ( create a 42 byte buffer called DV80)
68 ; S" DSK1.TEST DV80SO" DV80 FILE
69 ; DV80 #OPEN DROP
70 ; S" HELLO WORLD" DV80 #PUT DROP
71 ; DV80 #CLOSE
72 ;
73 7E52 7E42 fbufh data fileh,immed+5
73 7E54 8005
74 7E56 4642 text 'FBUF: '
74 7E58 5546
74 7E5A 3A20
75 7E5C 8320 fbuf data docol
76 7E5E 6F9A data create ; create dictionary entry
77 7E60 70B2 data lit,42,allot ; reserve 42 bytes
77 7E62 002A
77 7E64 70A2
78 7E66 832C data exit
79 ;]
80
81 ;[ #OPEN ( buf_addr -- t|f )
82 ; Opens a file with the file name and attributes specified in the buffer
83 ; starting at file_addr.
84 ; The buffer (actually a PAB) is set-up with FILE.
85 ; E.g. FBUF: SERIAL
86 ; S" RS232.BA=9600 DV80SO" SERIAL FILE
87 ; SERIAL #OPEN
88 ; The above shall attempt to open the serial port for output as a Display
89 ; Variable 80 type file.
90 ;
91 ; #OPEN leaves a FALSE on the stack if the file was opened sucessfully.
92 ; If the file could not be opened then it leaves a TRUE on the stack.
93 ; This allows easy trapping with ABORT" as shown below:
94 ; SERIAL #OPEN ABORT" Could not open serial port"
95 ;
96 ; In the event of a file error, IOERR can be read to get the DSR error code.
97 ; If IOERR returns -1 (>FFFF) then this means that no free file IO slots were
98 ; found. A maximum of 3 open files is supported (2 if block files are also to
99 ; be used).
100 ; Note that block files are immediately closed after they are accessed for
101 ; either reading or writing, so 3 generic file io streams are available
102 ; when no blocks files are being used.
103 7E68 7E52 fopenh data fbufh,5
103 7E6A 0005
104 7E6C 234F text '#OPEN '
104 7E6E 5045
104 7E70 4E20
105 7E72 7E74 fopen1 data $+2
106 7E74 06A0 bl @bank1
106 7E76 8332
107 7E78 79AA data _fopen ; see 1-14-File-IO.a99
108 ;]
109
110 ;[ #CLOSE ( fid -- )
111 ; closes a file
112 ; Where a file is opened thus: MYFILE #OPEN
113 ; the following will close the same file: MYFILE #CLOSE
114 7E7A 7E68 fclosh data fopenh,6
114 7E7C 0006
115 7E7E 2343 text '#CLOSE'
115 7E80 4C4F
115 7E82 5345
116 7E84 7E86 fclose data $+2
117 7E86 06A0 bl @bank1
117 7E88 8332
118 7E8A 7A10 data _fclos ; see 1-14-File-IO.a99
119 ;]
120
121 ;[ #GET ( buff_addr fid -- t|f )
122 ; reads a line of input from the file specified by fid.
123 ; The address of an appropriately sized buffer must be supplied.
124 ; If the read is successful, the buffer is filled with the data read from the
125 ; input device, with the first byte being the length count of the data
126 ; immediately following it.
127 ; This can be converted into an address/length pair with COUNT.
128 ; Returns:
129 ; False if successful
130 ; True if not successful
131 ; This allows trapping with ABORT" as follows:
132 ; MYFILE #GET ABORT" Could not read from the file"
133 ; If the read fails, IOERR is set to the error code, otherwise it is zero'd
134 7E8C 7E7A fgeth data fclosh,4
134 7E8E 0004
135 7E90 2347 text '#GET'
135 7E92 4554
136 7E94 7E96 fget data $+2
137 7E96 06A0 bl @bank1
137 7E98 8332
138 7E9A 7A34 data _fget ; see 1-14-File-IO.a99
139 ;]
140
141 ;[ #PUT ( buff_addr len fid - t|f )
142 ; Places a string from buffer_addr with length len to the file represented by
143 ; fid.
144 ; Returns false if successful, else returns true.
145 ; This can be trapped with ABORT"
146 7E9C 7E8C fputh data fgeth,4
146 7E9E 0004
147 7EA0 2350 text '#PUT'
147 7EA2 5554
148 7EA4 7EA6 fput data $+2
149 7EA6 06A0 bl @bank1
149 7EA8 8332
150 7EAA 7A70 data _fput ; see 1-14-File-IO.a99
151 ;]
152
153 ;[ #REC ( record# fid -- )
154 ; Sets the record number for reading or writing for relative files
155 7EAC 7E9C frech data fputh,4
155 7EAE 0004
156 7EB0 2352 text '#REC'
156 7EB2 4543
157 7EB4 7EB6 frec data $+2
158 7EB6 06A0 bl @bank1
158 7EB8 8332
159 7EBA 7AE2 data _frec ; see 1-14-File-IO.a99
160 ;]
161
162 ;[ #EOF? ( fid -- t|f )
163 ; returns true if currently positioned at the end of the file referenced by fid
164 7EBC 7EAC feofh data frech,5
164 7EBE 0005
165 7EC0 2345 text '#EOF? '
165 7EC2 4F46
165 7EC4 3F20
166 7EC6 7EC8 feof data $+2
167 7EC8 06A0 bl @bank1
167 7ECA 8332
168 7ECC 7AFC data _feof ; see 1-14-File-IO.a99
169 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-20-Sound.a99'
*
1 ; _____ _ __ __ _
2 ; / ____| | | \ \ / / | |
3 ; | (___ ___ _ _ _ __ __| | \ \ /\ / /__ _ __ __| |___
4 ; \___ \ / _ \| | | | '_ \ / _` | \ \/ \/ / _ \| '__/ _` / __|
5 ; ____) | (_) | |_| | | | | (_| | \ /\ / (_) | | | (_| \__ \
6 ; |_____/ \___/ \__,_|_| |_|\__,_| \/ \/ \___/|_| \__,_|___/
7
8 ; SN76489 register writes
9 ; -----------------------
10 ; When a byte is written to the SN76489, it processes it as follows:
11 ; %1cctdddd
12 ; d=data bits
13 ; t=type bits
14 ; c=channel bits
15 ;If bit 7 is 1 then the byte is a LATCH/DATA byte.
16 ;
17 ; Bits 6 and 5 (cc) give the channel to be latched, ALWAYS.
18 ; This selects the row in the above table.
19 ; %00 is channel 0, %01 is channel 1, %10 is channel 2, %11 is channel 3.
20 ; Bit 4 (t) determines whether to latch volume (1) or tone/noise (0) data.
21 ; The remaining 4 bits (dddd) are placed into the low 4 bits of the relevant
22 ; register.
23 ; For the three-bit noise register, the highest bit is discarded.
24 ; The latched register is NEVER cleared by a data byte.
25 ; If bit 7 is 0 then the byte is a DATA byte.
26 ;
27 ; %0-DDDDDD
28 ; |``````-- Data
29 ; `-------- Unused
30 ;
31 ; If the currently latched register is a tone register then the low 6 bits of
32 ; the byte (DDDDDD) are placed into the high 6 bits of the latched register.
33 ; If the latched register is less than 6 bits wide (ie. not one of the tone
34 ; registers), instead the low bits are placed into the corresponding bits of the
35 ; register, and any extra high bits are discarded.
36 ; The data have the following meanings (described more fully later):
37 ;
38 ; Tone registers
39 ; DDDDDDdddd = cccccccccc
40 ; DDDDDDdddd gives the 10-bit half-wave counter reset value.
41 ;
42 ; Volume registers
43 ; (DDDDDD)dddd = (--vvvv)vvvv
44 ;
45 ; dddd gives the 4-bit volume value.
46 ; If a data byte is written, the low 4 bits of DDDDDD update the 4-bit volume
47 ; value. However, this is unnecessary.
48 ;
49 ; Noise register
50 ; (DDDDDD)dddd = (---trr)-trr
51 ;
52 ; The low 2 bits of dddd select the shift rate and the next highest bit
53 ; (bit 2) selects the mode (white (1) or "periodic" (0)).
54 ; If a data byte is written, its low 3 bits update the shift rate and mode
55 ; in the same way.
56
57 ;[ SOUND ( pitch vol ch# -- )
58 7ECE 7EBC soundh data feofh,5
58 7ED0 0005
59 7ED2 534F text 'SOUND '
59 7ED4 554E
59 7ED6 4420
60 7ED8 7EDA sound data $+2
61 7EDA 0207 li r7,>8400 ; address of sound chip
61 7EDC 8400
62 ; set the channel...
63 7EDE C074 mov *stack+,r1 ; pop channel
64 7EE0 C201 mov r1,r8 ; save it
65 7EE2 0200 li r0,>9000 ; set msb and volume latch bit
65 7EE4 9000
66 7EE6 0B31 src r1,3 ; move channel into correct bit position
67 7EE8 E040 soc r0,r1 ; combine
68 ; set the volume...
69 7EEA C034 mov *stack+,r0 ; pop volume
70 7EEC 06C0 swpb r0 ; move to high byte
71 7EEE E040 soc r0,r1 ; combine
72 7EF0 D5C1 movb r1,*r7 ; move to sound chip
73 ; get pitch...
74 7EF2 0241 andi r1,>e000 ; reset t bit (to latch pitch)
74 7EF4 E000
75 7EF6 C034 mov *stack+,r0 ; pop pitch
76 7EF8 C080 mov r0,r2 ; copy it
77 7EFA 0240 andi r0,>000f ; get the low 4 bits
77 7EFC 000F
78 7EFE 06C0 swpb r0 ; move to high byte
79 7F00 E040 soc r0,r1 ; combine
80 7F02 D5C1 movb r1,*r7 ; move to sound chip
81 ; process noise channel if ch#=3...
82 7F04 0288 ci r8,3 ; noise channel?
82 7F06 0003
83 7F08 1302 jeq sndxit ; if so then just exit
84 7F0A 0A42 sla r2,4 ; get upper 6 bits in upper byte
85 7F0C D5C2 movb r2,*r7 ; send to sound chip
86 7F0E 045C sndxit b *next
87 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-21-Editor.a99'
*
1 ; ______ _ _ _ __ __ _
2 ; | ____| | (_) | \ \ / / | |
3 ; | |__ __| |_| |_ ___ _ __ \ \ /\ / /___ _ __ __| |___
4 ; | __| / _` | | __|/ _ \| '__| \ \/ \/ // _ \| '__/ _` / __|
5 ; | |____| (_| | | |_| (_) | | \ /\ /| (_) | | | (_| \__ \
6 ; |______|\__,_|_|\__|\___/|_| \/ \/ \___/|_| \__,_|___/
7 ; block editor
8
9 lastwd ; this is the last word in the built-in dictionary
10
11 ;[ EDIT ( block# -- )
12 ; loads 'block' and invokes the editor
13 ; on exit from the editor, location TEMP is checked. If not 0, it loads
14 ; the block number in TEMP.
15 7F10 7ECE edith data soundh,4
15 7F12 0004
16 7F14 4544 text 'EDIT'
16 7F16 4954
17 7F18 8320 edit data docol
18 7F1A 61FC data qdup,zbrnch,edit1 ; just exit if block#=0
18 7F1C 65F6
18 7F1E 7F54
19
20 ; if we happen to be in 32 column mode then switch to 40 column mode
21 7F20 77A6 data gxmax ; get xmax
22 7F22 70B2 data lit,32,eq ; is it equal to 32?
22 7F24 0020
22 7F26 647A
23 7F28 65F6 data zbrnch,edit_ ; just continue if not
23 7F2A 7F30
24 7F2C 6084 data lit0,gmode ; otherwise set 40 column mode as default
24 7F2E 795E
25
26 7F30 6D76 edit_ data cls ; clear the screen
27 7F32 6084 data lit0,lit,tib,store ; used as a flag for copy/paste
27 7F34 70B2
27 7F36 3420
27 7F38 6852
28
29 7F3A 7B98 edit0 data block,edit3 ; load block, invoke editor
29 7F3C 7F58
30
31 ; at this point, we have returned from the editor.
32 ; Check if the editor has requested another block...
33 7F3E 70B2 data lit,lstblk,store0
33 7F40 A1B4
33 7F42 6892
34 7F44 70B2 data lit,temp2,fetch,qdup ; get value in temp
34 7F46 A072
34 7F48 6830
34 7F4A 61FC
35 7F4C 65F6 data zbrnch,edit1 ; if 0 just exit
35 7F4E 7F54
36 7F50 65E4 data branch,edit0 ; otherwise, load next block
36 7F52 7F3A
37
38 7F54 6D76 edit1 data cls,exit ; clear screen and exit
38 7F56 832C
39
40 7F58 7F5A edit3 data $+2
41 7F5A 06A0 bl @bank1
41 7F5C 8332
42 7F5E 6EA2 data _edit ; see 1-11-Editor.a99
43 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-22-VDP.a99'
*
1 ; __ _______ _____ _ _ _ _ _ _ _ _
2 ; \ \ / / __ \| __ \ | | | | | (_) (_) | (_)
3 ; \ \ / /| | | | |__) | | | | | |_ _| |_| |_ _ ___ ___
4 ; \ \/ / | | | | ___/ | | | | __| | | | __| |/ _ | __|
5 ; \ / | |__| | | | |__| | |_| | | | |_| | __|__ \
6 ; \/ |_____/|_| \____/ \__|_|_|_|\__|_|\___|___/
7 ; VDP access utility routines
8
9 ;[ VDP addresses:
10 0000 83D7 vblnk equ >83D7 ; vertical blank counter
11 0000 8800 vdpr equ >8800 ; vdp read register
12 0000 8C00 vdpw equ >8C00 ; vdp write register
13 0000 8C02 vdpa equ >8C02 ; vdp address register
14 ;]
15
16 ; bit1 data >4000 ; used for re-setting bit 1
17 ; note: bit1 is now defined in LFREE in 0-07-Memory.a99
18
19 ;[ vdp single byte read
20 ; inputs: r0=address in vdp to read, r1(msb), the byte read from vdp
21 ; side effects: none
22 7F60 C820 vsbr mov @bank0,@retbnk ; return to bank 0 if interrupt should trigger
22 7F62 606A
22 7F64 A06E
23 7F66 0300 limi 2 ; briefly enable interrupts
23 7F68 0002
24 7F6A 0300 limi 0 ; and switch 'em off again
24 7F6C 0000
25 7F6E 06C0 swpb r0 ; get low byte of address
26 7F70 D800 movb r0,@vdpa ; write it to vdp address register
26 7F72 8C02
27 7F74 06C0 swpb r0 ; get high byte
28 7F76 D800 movb r0,@vdpa ; write
28 7F78 8C02
29 7F7A 1000 nop
30 7F7C D060 movb @vdpr,r1 ; write payload
30 7F7E 8800
31 7F80 045B rt ; see ya
32 ;]
33
34 ;[ vdp multiple byte read
35 ; inputs: r0=vdp source address, r1=cpu ram destination address
36 ; r2=number of bytes to read
37 ; side effects: r1 & r2 changed
38 7F82 06C0 vmbr swpb r0 ; get low byte of address
39 7F84 D800 movb r0,@vdpa ; write it
39 7F86 8C02
40 7F88 06C0 swpb r0 ; get high byte of address
41 7F8A D800 movb r0,@vdpa ; write it
41 7F8C 8C02
42 7F8E 020F li r15,vdpr ; cache vdp write register address in r15
42 7F90 8800
43 7F92 DC5F vmbr1 movb *r15,*r1+ ; fast write to vdp register
44 7F94 0602 dec r2 ; finished?
45 7F96 16FD jne vmbr1 ; loop if not
46 7F98 045B rt ; so long
47 ;]
48
49 ;[ vdp single byte write
50 ; inputs: r0=address in vdp to write to, r1(msb)=the byte to write
51 ; side effects: none
52 7F9A C820 vsbw mov @bank0,@retbnk ; return to bank 0 if interrupt should trigger
52 7F9C 606A
52 7F9E A06E
53 7FA0 0300 limi 2 ; briefly enable interrupts
53 7FA2 0002
54 7FA4 0300 limi 0 ; but too long, we're British you know
54 7FA6 0000
55 7FA8 0260 vsbw0 ori r0,>4000 ; tell VDP processor "hey, this is a *write*"
55 7FAA 4000
56 7FAC 06C0 swpb r0 ; get low byte of address
57 7FAE D800 movb r0,@vdpa ; write it to vdp address register
57 7FB0 8C02
58 7FB2 06C0 swpb r0 ; get high byte of address
59 7FB4 D800 movb r0,@vdpa ; write it
59 7FB6 8C02
60 7FB8 D801 movb r1,@vdpw ; write payload
60 7FBA 8C00
61 7FBC 2820 xor @bit1,r0 ; reset bit 1
61 7FBE 695E
62 7FC0 045B rt ; we'd love to stay, but we have a long drive...
63 ;]
64
65 ;[ vdp multiple byte write
66 ; r0=destination in vdp, r1=source address in cpu ram, r2=number of bytes
67 ; side effects: r1 & r2 changed
68 7FC2 C820 vmbw mov @bank0,@retbnk ; return to bank 0 if interrupt should trigger
68 7FC4 606A
68 7FC6 A06E
69 7FC8 0300 limi 2 ; briefly enable interrupts
69 7FCA 0002
70 7FCC 0300 limi 0 ; this is getting boring now
70 7FCE 0000
71 7FD0 0260 vmbw0 ori r0,>4000 ; if you can't figure this out by now
71 7FD2 4000
72 7FD4 06C0 swpb r0 ; then try the Commodore 64
73 7FD6 D800 movb r0,@vdpa ; it's a much inferior machine
73 7FD8 8C02
74 7FDA 06C0 swpb r0 ; with the worlds worst processor
75 7FDC D800 movb r0,@vdpa ; though Chuck Peddle is extremely cool
75 7FDE 8C02
76 7FE0 020F li r15,vdpw ; and you have to hand it to Jack Tramiel too.
76 7FE2 8C00
77 7FE4 D7F1 vmbw1 movb *r1+,*r15 ; Anyway the C64 has much simpler hardware
78 7FE6 0602 dec r2 ; and a super simple (i.e. super sucky) CPU
79 7FE8 16FD jne vmbw1 ; but hey, it *does* have 64K of ram, the lucky
80 7FEA 2820 xor @bit1,r0 ; old git.
80 7FEC 695E
81 7FEE 045B rt ; been nice chatting with ya...
82 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank0\0-23-System.a99'
*
1 ; ____ __ __ _
2 ; | _ \ / _|/ _| | |
3 ; | |_) |_ _| |_| |_ ___ _ __ ___ __ _ _ __ __| |
4 ; | _ <| | | | _| _/ _ \ '__/ __| / _` | '_ \ / _` |
5 ; | |_) | |_| | | | || __/ | \__ \ | (_| | | | | (_| |
6 ; |____/ \__,_|_| |_| \___|_| |___/ \__,_|_| |_|\__,_|
7 ; __ __ _ _ _
8 ; \ \ / / (_) | | | |
9 ; \ \ / /__ _ _ __ _ __ _| |__ | | ___ ___
10 ; \ \/ // _` | '__| |/ _` | '_ \| |/ _ | __|
11 ; \ /| (_| | | | | (_| | |_) | | __|__ \
12 ; \/ \__,_|_| |_|\__,_|_.__/|_|\___|___/
13
14 0000 7FF0 endB0 equ $ ; end of bank 0 marker
15
16 dorg >a000
17 ; note: during initialisation, GPLLNK uses >A000 to >A01F as workspace
18 ; to load the upper case characters from console GROM. After this,
19 ; the space is re-used.
20
21 ;[ Vectors - the locations of these vectors MUST NOT change between builds
22 A000 0000 intvec bss 2 ; vector for INTERPRET >a000
23 A002 0000 blkvec bss 2 ; vector for BLOCK >a002
24 A004 0000 numvec bss 2 ; vector for NUMBER >a004
25 A006 0000 fndvec bss 2 ; vector for FIND >a006
26 A008 0000 usrisr bss 2 ; vector for user isr >a008
27 A00A 0000 _wwrap bss 2 ; word-wrap on/off >a00a
28 A00C 0000 dsrvec bss 2 ; pointer to DSRLNK vector in bank 1 >a00c
29 A00E 0000 gplvec bss 2 ; pointer to GPLLNK vector in bank 1 >a00e
30 A010 0000 padvec bss 2 ; pointer to scratchpad restore code in bank 1. >a010
31 ; Assembly language vector for returning to TF from external assembly code
32 ; that runs in a different workspace.
33 ; External assembly code (for example, code written with the TF assembler)
34 ; that changes workspace can simply perform a BLWP @>A012 to restore TF's
35 ; workspace and jump to NEXT in the inner interpreter, which will restore
36 ; normal Forth execution perfectly.
37 A012 0000 wp bss 2 ; >a012 - workspace pointer.
38 ; software can actually change TF's workspace while running.
39 ; a copy of the desired workspace address MUST be written
40 ; here so that KEY can restore the correct workspace address
41 ; after its call into the TI ROM.
42
43 A014 0000 pnext bss 2 ; >a014 pointer to next
44 A016 0000 pdocon bss 2 ; >a016 pointer to DOCON's executable code
45 A018 0000 pcreate bss 2 ; >a018 pointer to CREATE's executable code
46 ; new vectors MUST be added here
47 ;]
48
49 ;[ memory space pointers
50 A01A 0000 ffailm bss 2 ; >a01a first free address in low memory pointer
51 A01C 0000 ffaihm bss 2 ; >a01c first free address in hi memory pointer
52 ;]
53
54 ;[ stack pointers
55 A01E 0000 s0 bss 2 ; reserved for FORTH variable S0 - holds the address of the
56 ; start of the data stack (r4)
57
58 A020 0000 rs0 bss 2 ; address of start of return stack (r5)
59 ;]
60
61 ;[ screen, keyboard and file I/O
62 A022 0000 keydev bss 2 ; keyboard device to use for KSCAN routine in console ROM
63 A024 0000 cursrd bss 2 ; cursor delay used in KEY and the editor
64 A026 0000 noscrl bss 2 ; suppress screen scrolling. >0=suppress
65 A028 0000 scrX bss 2 ; x co-ordinate of next character to be displayed on screen
66 A02A 0000 scrY bss 2 ; y co-ordinate of next character to be displayed on screen
67 A02C 0000 xmax bss 2 ; screen width - 32, 40 or 80
68 A02E 0000 ymax bss 2 ; screen height - always 24
69 A030 0000 wrap bss 2 ; used to determine if wrap-around is used by SCROLL
70 A032 0000 panxy bss 2 ; starting screen address (top left) of panel
71 A034 0000 panr bss 2 ; number of rows in panel
72 A036 0000 panc bss 2 ; number of columns in panel
73 A038 0000 errnum bss 2 ; holds io error number of last error
74 ;]
75
76 ;[ speech synthesis
77 A03A 0000 spcnt bss 2 ; number of bytes remaining in speech buffer
78 A03C 0000 spadr bss 2 ; address of next byte in speech buffer
79 A03E 0000 spcsvc bss 2 ; speech service: address of the speech service which should
80 ; be called by the ISR is placed here. (either the routine
81 ; to stream raw speech data, or the routine to feed speech
82 ; ROM addresses).
83
84 A040 0000 synyes bss 2 ; 0=speech synth not fitted. >FFFF=speech synth detected
85 ;]
86
87 ;[ parsing/compilation
88 A042 0000 in bss 2 ; holds the current index into the terminal input buffer
89 ; (TIB) - used by variable >IN
90
91 A044 0000 latest bss 2 ; reserved for FORTH variable LATEST, which points to the
92 ; most recently defined word in the dictionary.
93
94 A046 0000 here bss 2 ; points to the next free byte of memory. When compiling,
95 ; compiled words go HERE.
96
97 A048 0000 _state bss 2 ; is the interpreter interpreting (0) or compiling a word
98 ; (!=0).
99
100 A04A 0000 tibsiz bss 2 ; characters per line: 80 on command line, 64 in blocks
101 A04C 0000 _span bss 2 ; the number of characters received by EXPECT.
102 ; See variable #TIB.
103
104 A04E 0000 doboot bss 2 ; "we're booting" flag (>0=booting)
105 A050 0000 sdelim bss 2 ; stores the end of string marker (normally ") for S".
106 ; the word .( sets it temporarily to a ) character.
107
108 A052 0000 isdbl bss 2 ; flag to indicate if NUMBER pushed a double (>0=yes)
109 A054 0000 dpl bss 2 ; decimal point location. set by NUMBER (doubles only)
110 A056 0000 cassen bss 2 ; if 0 dictionary searches are case sensitive
111 A058 0000 source bss 2 ; source-id. -1=string (via evaluate).
112 ; 0=user input (keyboard/block).
113
114 A05A 0000 dotsin bss 2 ; flag for .S to use signed or unsigned numbers
115 A05C 0000 base bss 2 ; the current base for printing and reading numbers
116 A05E 0000 lbase bss 2 ; last number base, used by Number to String routine
117 A060 0000 expcnt bss 2 ; exponent count, used by Number to String routine
118 A062 0000 lzi bss 2 ; leading zero indicator, used by N>S routine to determine
119 ; if leading 0's are ignored.
120
121 A064 0000 dosign bss 2 ; flag for NTS routine. If >0, then NTS will treat numbers
122 ; as unsigned, set by U. and .
123
124 A066 0000 _warn bss 2 ; redefinition warnings are suppressed if _warn=0
125 A068 0000 coding bss 2 ; !0 if CODE: compiling is active
126 A06A 0000 patch bss 2 ; holds the CFA of latest word created with CREATE in case
127 ; DOES> needs to patch it
128 ;]
129
130 ;[ misc
131 A06C 0000 vdpr1 bss 2 ; copy of vdp register 1 (stored at 83d4)
132 A06E 0000 retbnk bss 2 ; holds bank number to return to as a memory address
133 ; (>6000 or >6002)
134 A070 0000 temp bss 2 ; for temporary storage
135 A072 0000 temp2 bss 2 ; for temporary storage
136 A074 0000 temp3 bss 2 ; for temporary storage
137 A076 0000 seed bss 2 ; seed for random number generation
138 A078 0000 sumode bss 2 ; graphics mode selected from cartridge menu screen
139 ;]
140
141 ;[ editor variables - only used by the built in editor
142 A07A 0000 epage bss 2 ; holds block editor page
143 ; note: These variables use the same addresses as the compiler reference
144 ; counters (below). This is safe to do, as the compiler is never in use when
145 ; the editor is in use, and vice versa. Hence it makes sense to use the same
146 ; addresses and save some valuable user RAM in low-memory. I'm nice like that.
147 0000 A07C csrx equ $ ; cursor x for editor
148 0000 A07E csry equ $+2 ; cursor y for editor
149 0000 A080 csrflg equ $+4 ; cursor blink flag for editor
150 0000 A082 autorp equ $+6 ; keyboard auto repeat counter
151 0000 A084 autorl equ $+8 ; keyboard auto repeat re-load value
152 0000 A086 edblk equ $+10 ; block number of the block currently being edited
153 ;]
154
155 ;[ reference counters for compiler security
156 ; see the words : and ; in 0-10-Compilation.a99
157 A07C 0000 ifcnt bss 2 ; incremented by IF, decremented by THEN
158 A07E 0000 docnt bss 2 ; incremented by DO, decremented by LOOP & +LOOP
159 A080 0000 forcnt bss 2 ; incremented by FOR, decremented by NEXT
160 A082 0000 cascnt bss 2 ; incremented by CASE, decremented by ENDCASE
161 A084 0000 ofcnt bss 2 ; incremented by OF, decremented by ENDOF
162 A086 0000 begcnt bss 2 ; incremented by BEGIN, decremented by UNTIL, REPEAT & AGAIN
163 ;]
164
165 ;[ sprite buffers
166 A088 0000 sal bss 128 ; sprite attribute list
167 A108 0000 smlist bss 64 ; sprite movement list
168 ;]
169
170 ;[ Persistable data for file IO
171 A148 0000 sav8a bss 2 ; save data following blwp @dsrlnk (8 or >a)
172 A14A 0000 savcru bss 2 ; cru address of the peripheral
173 A14C 0000 savent bss 2 ; entry address of dsr or subprogram
174 A14E 0000 savlen bss 2 ; device or subprogram name length
175 A150 0000 savpab bss 2 ; pointer to device or subprogram in the pab
176 A152 0000 savver bss 2 ; version # of dsr
177 A154 0000 flgptr bss 2 ; pointer to flag in pab (byte 1 in pab)
178 A156 0000 dsrlws bss 10 ; data 0,0,0,0,0 ; dsrlnk workspace
179 A160 0000 dstype bss 22 ; data 0,0,0,0,0,0,0,0,0,0,0
180 A176 0000 haa bss 2 ; used to store AA pattern for DSR ROM detection
181 A178 0000 namsto bss 8 ; dsrlnk 8 bytes device name buffer
182 ;]
183
184 ;[ scratch pab - used for block IO
185 A180 00 pabopc byte 0 ; opcode: open, read, etc
186 A181 00 pabflg byte 0 ; error code & file type
187 A182 0000 pabbuf data 0 ; vdp address of data
188 A184 00 pablrl byte 0 ; logical record length
189 A185 00 pabcc byte 0 ; output character count
190 A186 0000 pabrec data 0 ; record number
191 A188 00 pabsco byte 0 ; screen offset for char
192 A189 00 pabnln byte 0 ; name length
193 A18A 0000 pabfil bss 32 ; file name starts here
194 even
195 ;]
196
197 ;[ set up the pab pointers:
198 0000 8356 namptr equ >8356 ; address of pointer to name length in PABs
199 0000 1800 f1pab equ >1800 ; vdp address of 40 byte PAB buffer for file 1
200 0000 1828 f1buf equ >1828 ; vdp address of 256 byte record buffer for file 1
201 0000 1928 f2pab equ >1928 ; vdp address of 40 byte PAB buffer for file 2
202 0000 1950 f2buf equ >1950 ; vdp address of 256 byte record buffer for file 2
203 0000 1A50 f3pab equ >1a50 ; vdp address of 40 byte PAB buffer for file 3
204 0000 1A78 f3buf equ >1a78 ; vdp address of 256 byte record buffer for file 3
205 0000 1B78 pabloc equ >1b78 ; vdp address of block IO PAB
206 0000 1BA0 recbuf equ >1ba0 ; vdp address of data buffer. 128 bytes to store 1 record
207 0000 1C20 bufadd equ >1c20 ; vdp address of block buffer 0
208
209 A1AA 0000 falloc bss 6 ; allocation table for file IO
210 ; at run time, these 3 words are filled with addresses f1pab, f2pab & f3pab.
211 ; The MSB is set when a file is in use (i.e. when opened with #OPEN).
212 ; The MSB is reset when #CLOSE is executed, and thus the file 'slot' can be
213 ; re-used.
214 ;]
215
216 ;[ block related data
217 ; see 0-18-Blocks.a99
218 0000 0006 blocks equ 6 ; number of block buffers
219 A1B0 0000 totblk bss 2 ; number of block buffers available
220 A1B2 0000 blknum bss 2 ; holds the block currently being compiled by INTERPRET
221 A1B4 0000 lstblk bss 2 ; holds the block currently being worked on
222 A1B6 0000 blk0 bss 2 ; block number of the block stored in buf0 (0=unassigned)
223 A1B8 0000 bss 2 ; VDP address of block0 MSB=1=dirty block
224 A1BA 0000 blk1 bss 2 ; block number of the block stored in buf1 (0=unassigned)
225 A1BC 0000 bss 2 ; VDP address of block1 MSB=1=dirty block
226 A1BE 0000 blk2 bss 2 ; block number of the block stored in buf2 (0=unassigned)
227 A1C0 0000 bss 2 ; VDP address of block2 MSB=1=dirty block
228 A1C2 0000 blk3 bss 2 ; block number of the block stored in buf3 (0=unassigned)
229 A1C4 0000 bss 2 ; VDP address of block3 MSB=1=dirty block
230 A1C6 0000 blk4 bss 2 ; block number of the block stored in buf4 (0=unassigned)
231 A1C8 0000 bss 2 ; VDP address of block4 MSB=1=dirty block
232 A1CA 0000 blk5 bss 2 ; block number of the block stored in buf5 (0=unassigned)
233 A1CC 0000 bss 2 ; VDP address of block5 MSB=1=dirty block
234 ; note: the vdp addresses of the block buffers are defined in
235 ; 1-15-Initialise.a99
236 ;]
237
238 ;[ stacks and buffers
239 ; don't change the order of these buffers!
240 A1CE 0000 tibadr bss 2 ; address of the terminal input buffer
241 0000 3420 tib equ >3420 ; vdp address of terminal input buffer
242 A1D0 0000 wrdbuf bss 82
243 A222 0000 wrkbuf bss 32 ; work buffer for Number to String routine (holds exponents)
244 A242 0000 strbuf bss 18 ; string buffer for Number to String routine to construct
245 ; a string in
246 ;]
247
248 ;[ data stack and return stack
249 A254 0000 stacks bss 114 ; reserve space for data stack and return stack
250 0000 A28A retstk equ stacks+54 ; return stack grows to lower addresses
251 0000 A2C6 dstack equ $ ; data stack grows to lower addresses
252 ;]
253
254 ;[ start of user memory... FORTH programs go here!
255 0000 A2C6 himem equ $ ; first free address in hi memory
256 0000 A2C6 prgtop equ himem ; program space - user defined FORTH words start here
257 ; at startup, HERE points to prgtop
258 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-00-Header.a99'
*
1 ; _____ _ _____ _ _
2 ; |_ _|_ _ _ __| |__ ___ | ___|___ _ __| |_| |__
3 ; | | | | | | '__| '_ \ / _ \| |_ / _ \| '__| __| '_ \
4 ; | | | |_| | | | |_) | (_) | _|| (_) | | | |_| | | |
5 ; |_| \__,_|_| |_.__/ \___/|_| \___/|_| \__|_| |_|
6 ; ################################################
7 ; TurboForth
8 ; (C) Mark Wills 2010-2012
9 ; Written in TMS9900 machine code for the TI-99/4A
10 ; May the Forth be with you.
11 ; ################################################
12 ; ____ _ _
13 ; | __ ) __ _ _ __ | | __ / |
14 ; | _ \ / _` | '_ \| |/ / | |
15 ; | |_) | (_| | | | | < | |
16 ; |____/ \__,_|_| |_|_|\_\ |_|
17 ;
18 ; This is bank 1 - the secondary bank
19 ; This bank consists of subroutines called by bank 0
20 ;
21 ; Cartridge header. Unfortunatley, we cannot know for sure that the
22 ; correct bank will be selected at power-up, thus we need to duplicate
23 ; the cartridge header here. This header is slightly different however,
24 ; it copies a simple bootstrap routine to pad ram which selects bank 0
25 ; and then jumps to the real bootstrap code in bank 0
26
27 aorg >6000 ; cartridge rom
28
29 ; cartridge ROM header
30
31 6000 AA byte >aa ; standard header
32 6001 0C byte >0c ; version number
33 6002 01 byte >01 ; number of programs
34 6003 00 byte >00 ; not used
35 6004 0000 data >0000 ; pointer to power-up list
36 6006 600C data menu ; pointer to program list
37 6008 0000 data 0 ; pointer to DSRL list
38 600A 0000 data 0 ; pointer to subprogram list
39
40 600C 6026 data menu40 ; pointer to next menu item
41 600E 605C data start80 ; code entry point
42 6010 14 byte 20 ; length of text
43 6011 5455 text 'TURBOFORTH 80 COLUMN'
43 6013 5242
43 6015 4F46
43 6017 4F52
43 6019 5448
43 601B 2038
43 601D 3020
43 601F 434F
43 6021 4C55
43 6023 4D4E
44 6025 0000 even
45 6026 0000 data 0 ; no more menu entries
46 6028 6052 data start40 ; code entry point (see below)
47 602A 11 byte 17 ; length of text
48 602B 5455 text 'TURBOFORTH V1.2.1:1 (c) 2015 Mark Wills'
48 602D 5242
48 602F 4F46
48 6031 4F52
48 6033 5448
48 6035 2056
48 6037 312E
48 6039 322E
48 603B 313A
48 603D 3120
48 603F 2863
48 6041 2920
48 6043 3230
48 6045 3135
48 6047 204D
48 6049 6172
48 604B 6B20
48 604D 5769
48 604F 6C6C
48 6051 73
49 even
50
51 ; 40 column mode entry point
52 6052 02E0 lwpi wkspc
52 6054 8300
53 6056 04E0 clr @sumode
53 6058 A078
54 605A 1009 jmp startB1
55
56 ; 80 column mode entry point
57 605C 02E0 lwpi wkspc
57 605E 8300
58 6060 0200 li r0,2
58 6062 0002
59 6064 C800 mov r0,@sumode
59 6066 A078
60 6068 1002 jmp startB1
61
62 ; codes for bank 0 and bank 1 - used by the interrupt handler to determine
63 ; which bank to return to after processing an interrupt.
64 ; Set by the VDP routines (see 0-21-VDP.a99).
65 ; DO NOT MOVE THESE! Identical definitions are made in bank 0, and they MUST
66 ; be at identical addresses!
67 606A 6002 data >6002 ; code to select bank 0
68 606C 6000 data >6000 ; code to select bank 1
69
70
71 606E 0300 startB1 limi 0 ; no interrupts - we're British
71 6070 0000
72 6072 04E0 clr @>6000 ; select bank1
72 6074 6000
73 6076 0460 b @init ; init is defined in 1-15-Initialise.a99
73 6078 7B76
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-01-ISR.a99'
*
1 ; _____ _ _
2 ; |_ _| | | | |
3 ; | | _ __ | |_ ___ _ __ _ __ _ _ _ __ | |_
4 ; | | | '_ \| __|/ _ \ '__| '__| | | | '_ \| __|
5 ; _| |_| | | | |_| __/ | | | | |_| | |_) | |_
6 ; |_____|_| |_|\__|\___|_| |_| \__,_| .__/ \__|
7 ; | |
8 ; |_|
9 ; _____ _ _
10 ; | __ \ | | | |
11 ; | | | | ___ ___ _ __ __ _| |_ ___| |__ ___ _ __
12 ; | | | |/ _ | __| '_ \ / _` | __|/ __| '_ \ / _ \ '__|
13 ; | |__| | __|__ \ |_) | (_| | |_| (__| | | | __/ |
14 ; |_____/ \___|___/ .__/ \__,_|\__|\___|_| |_|\___|_|
15 ; | |
16 ; |_|
17 ; ISR despatcher - determines which ISR to call
18 ; Speech is serviced every frame, sprites and music are serviced every alternate
19 ; frame.
20
21 607A C28B isrdes mov r11,r10 ; save return address to pad isr
22
23 ; Speech Handling ISR
24 ; Called every frame
25 ; Checks to see if there is any speech to process, if not, just exits
26 ; If there is, either calls ROMSPK to speak words from the speech ROM or calls
27 ; STRSPK to send a raw byte stream to the synth, depending on the address loaded
28 ; into SPCSVC.
29 ;
30 ; First service any speech that is waiting to be sent to the speech synth
31 ; if no speech is outstanding then exit the isr completely...
32 607C C020 speech mov @spcsvc,r0 ; get speech service address in r0
32 607E A03E
33 6080 1301 jeq isrnxt ; if 0 then there is no speech to process so
34 6082 0450 b *r0 ; exit otherwise jump to the routine
35
36 ; check user isr
37 6084 C020 isrnxt mov @usrisr,r0 ; get user interrupt service routine address
37 6086 A008
38 6088 1301 jeq isrout ; if zero then quit isr processing
39 608A 0690 bl *r0 ; otherwise branch and link to user ISR
40 ; (user ISR code should execute an RT to
41 ; return here)
42
43 608C 0460 isrout b @isrxit ; return to Forth environment
43 608E 8354
44
45 ; ------------------------------------------------------------------------------
46
47 0000 0008 refill equ 8 ; # of bytes to refill the synth fifo with
48 ;[ 'stream-speak' routine to feed raw speech bytes to the speech synth
49 strspk
50 ; if speech synth is already busy then just exit, we'll start up proper
51 ; when the synth is idle...
52 6090 06A0 bl @spstat ; get speech synth status
52 6092 8340
53 6094 C020 mov @spdata,r0 ; get the status from pad ram
53 6096 834A
54 6098 0240 andi r0,>8000 ; check busy flag
54 609A 8000
55 609C 162A jne strxit ; exit if busy
56 ; speech unit is idle... fill fifo with 16 bytes of speech data...
57 609E C020 mov @spadr,r0 ; address of speech data
57 60A0 A03C
58 60A2 0202 li r2,16 ; 16 bytes to fill the fifo
58 60A4 0010
59 60A6 D830 strsp2 movb *r0+,@spchwt ; write a byte to the speech synth
59 60A8 9400
60 60AA 0602 dec r2 ; decrement loop counter
61 60AC 16FC jne strsp2 ; loop if not finished
62 60AE 0201 li r1,-16 ; reduce bytes remaining by 16
62 60B0 FFF0
63 60B2 A801 a r1,@spcnt ; store it
63 60B4 A03A
64 60B6 C800 mov r0,@spadr ; store address of data
64 60B8 A03C
65 60BA 0200 li r0,strsp3 ; new entry point for the next interrupt
65 60BC 60C4
66 60BE C800 mov r0,@spcsvc ; load it
66 60C0 A03E
67 60C2 1017 jmp strxit ; quit. we'll enter at STRSP3 on the next
68 ; interrupt
69 ; check fifo level. If fifo low, stream 8 bytes (or until data is exhausted)
70 ; to the fifo
71 60C4 06A0 strsp3 bl @spstat ; get synth status
71 60C6 8340
72 60C8 C020 mov @spdata,r0 ; move status from pad ram
72 60CA 834A
73 60CC 0240 andi r0,>4000 ; check fifo low bit
73 60CE 4000
74 60D0 1310 jeq strxit ; if not on, then exit - fifo doesn't need
75 ; filling
76 60D2 C020 mov @spadr,r0 ; buffer address
76 60D4 A03C
77 60D6 C060 mov @spcnt,r1 ; bytes remaining
77 60D8 A03A
78 60DA 0202 li r2,refill ; 'refill' bytes to stream
78 60DC 0008
79 60DE D830 strnb movb *r0+,@spchwt ; send a byte to the fifo
79 60E0 9400
80 60E2 0601 dec r1 ; decrement bytes remaining count
81 60E4 1307 jeq strcu ; if all data exhausted then clean up
82 60E6 0602 dec r2 ; decrement counter
83 60E8 16FA jne strnb ; do next byte if not finished
84 60EA C800 mov r0,@spadr ; store address
84 60EC A03C
85 60EE C801 mov r1,@spcnt ; store count
85 60F0 A03A
86 60F2 10C8 strxit jmp isrnxt ; go check user isr
87 ; we've streamed all the data, clean up and exit
88 60F4 04E0 strcu clr @spcsvc ; clear speech service pointer - we're done
88 60F6 A03E
89 60F8 10C5 jmp isrnxt ; go check user isr
90 ;]
91
92 ;[ 'rom-speak' routine to feed rom addresses to the speech synth
93 romspk ; check speech synth, exit if synth is busy...
94 60FA 06A0 bl @spstat ; get status from speech synth into
94 60FC 8340
95 ; scratch-pad ram
96 60FE C020 mov @spdata,r0 ; get the data from speech synth
96 6100 834A
97 6102 0240 andi r0,>8000 ; speech synth busy?
97 6104 8000
98 6106 1613 jne romspx ; exit if busy
99 ; speech synth isn't busy... send a word of data...
100 6108 C060 mov @spadr,r1 ; get address of data word
100 610A A03C
101 610C C031 mov *r1+,r0 ; get the word in r0 for spaddr
102 610E C801 mov r1,@spadr ; update buffer address
102 6110 A03C
103 ; convert the address to nybbles and send to the speech synth...
104 6112 06A0 bl @spaddr ; load the address contained in r0
104 6114 66B2
105 ; 42uS delay required before the 'talk' command can be issued to the speech
106 ; synth. see editor/assembler manual, section 22.1.1, page 349
107 6116 0200 li r0,20
107 6118 0014
108 611A 0600 dly42 dec r0 ; spin the wheels...
109 611C 16FE jne dly42
110 ; send 'talk from rom' opcode to speech synth to make the synth actually
111 ; talk...
112 611E D820 movb @spkROM,@spchwt ; send 'speak from rom op-code'
112 6120 662A
112 6122 9400
113 ; synth is now talking
114 ; do isr housekeeping...
115 6124 0620 dec @spcnt ; decrement 'speech data remaining' counter
115 6126 A03A
116 6128 1602 jne romspx ; if not zero then just exit
117 612A 04E0 clr @spcsvc ; otherwise clear speech-service-routine
117 612C A03E
118 ; pointer since there is no more data to
119 ; service.
120 612E 0460 romspx b @isrxit ; return to next stage of isr handler
120 6130 8354
121 ; (in 1-15-initialise.a99)
122 ;]
123 ; end of speech ISR
124 ; -----------------------------------------------------------------------------
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-02-Console.a99'
*
1 ; _____ _ __ __ _
2 ; / ____| | | \ \ / / | |
3 ; | | ___ _ __ ___ ___ | | ___ \ \ /\ / /___ _ __ __| |___
4 ; | | / _ \| '_ \/ __|/ _ \| |/ _ \ \ \/ \/ // _ \| '__/ _` / __|
5 ; | |____| (_) | | | \__ \ (_) | | __/ \ /\ /| (_) | | | (_| \__ \
6 ; \_____|\___/|_| |_|___/\___/|_|\___| \/ \/ \___/|_| \__,_|___/
7 ; Console IO words
8
9 ;[ PAGE ( -- ) see 0-09-Console.a99
10 6132 06A0 _cls bl @cls_ ; Forth word entry point
10 6134 613A
11 6136 0460 b @retB0
11 6138 833A
12 ; entry point if called as assembler subroutine:
13 613A C18B cls_ mov r11,r6 ; save return address
14 613C C060 mov @xmax,r1 ; calculate the character count
14 613E A02C
15 6140 0200 li r0,24 ; according to the...
15 6142 0018
16 6144 3840 mpy r0,r1 ; ...text mode
17 6146 04C0 clr r0 ; screen address
18 6148 0201 li r1,>2000 ; space character
18 614A 2000
19 614C 06A0 bl @vsbwmi ; wipe screen
19 614E 7880
20 6150 04E0 clr @scrX ; zero x coordinate
20 6152 A028
21 6154 04E0 clr @scrY ; zero y coordinate
21 6156 A02A
22 6158 0456 b *r6 ; return to caller
23 ;]
24
25 ;[ JOYST ( joystick# -- value )
26 ; Scans the joystick returning the direction value
27 615A C054 _joyst mov *stack,r1 ; get unit number
28 615C 0221 ai r1,6 ; use keyboard select 6 for #0, 7 for #1
28 615E 0006
29 6160 06C1 swpb r1
30 6162 020C li r12,36
30 6164 0024
31 6166 30C1 ldcr r1,3
32 6168 020C li r12,6
32 616A 0006
33 616C 3541 stcr r1,5
34 616E 06C1 swpb r1
35 6170 0541 inv r1
36 6172 0241 andi r1,>001f
36 6174 001F
37 6176 C501 mov r1,*stack
38 6178 020C li r12,_next
38 617A 8326
39 617C C80C mov r12,@>83d6 ; defeat auto screen blanking
39 617E 83D6
40 6180 C820 mov @bank1_,@retbnk ; return to bank 1 if interuupts should fire
40 6182 606C
40 6184 A06E
41 6186 0300 limi 2 ; briefly enable interrupts
41 6188 0002
42 618A 0300 limi 0 ; and turn 'em off again
42 618C 0000
43 618E 0460 b @retb0 ; return to caller in bank 0
43 6190 833A
44 ;]
45
46
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-03-Graphics.a99'
*
1 ; _____ _ _ __ __ _
2 ; / ____| | | (_) \ \ / / | |
3 ; | | __ _ __ __ _ _ __ | |__ _ ___ ___ \ \ /\ / /___ _ __ __| |___
4 ; | | |_ | '__/ _` | '_ \| '_ \| |/ __/ __| \ \/ \/ // _ \| '__/ _` / __|
5 ; | |__| | | | (_| | |_) | | | | | (__\__ \ \ /\ /| (_) | | | (_| \__ \
6 ; \_____|_| \__,_| .__/|_| |_|_|\___|___/ \/ \/ \___/|_| \__,_|___/
7 ; | |
8 ; |_|
9 ; graphics related commands
10
11 ;[ GMODE ( gmode -- )
12 6192 C234 _gmode mov *stack+,r8 ; pop gmode
13 6194 0288 ci r8,0 ; 40 column mode?
13 6196 0000
14 6198 1306 jeq s40col ; jump if yes
15 619A 0288 ci r8,1 ; 32 column mode?
15 619C 0001
16 619E 1306 jeq s32col ; jump if yes
17 61A0 0288 ci r8,2 ; 80 column mode?
17 61A2 0002
18 61A4 1306 jeq s80col ; jump if yes
19 ; otherwise illegal graphics mode selected,
20 ; so fall through to 40 column mode...
21 61A6 0202 s40col li r2,col40d ; vdp register data for 40 column mode
21 61A8 622A
22 61AA 1005 jmp ldvdpr ; go load the vdp registers
23 61AC 0202 s32col li r2,col32d ; vdp register data for 32 column mode
23 61AE 6234
24 61B0 1002 jmp ldvdpr ; go load the vdp registers
25 61B2 0202 s80col li r2,col80d ; vdp register data for 80 column mode
25 61B4 623E
26 ; load the vdp registers
27 61B6 C1C2 ldvdpr mov r2,r7 ; save address for later
28 61B8 D072 movb *r2+,r1 ; number of registers to load
29 61BA 0881 sra r1,8 ; move the count to the low byte
30 61BC 04C0 clr r0 ; start with register 0
31 61BE D032 ldvdpl movb *r2+,r0 ; get register data in r0 MSB
32 61C0 06C0 swpb r0 ; swap it over
33 61C2 06A0 bl @_vwtr ; write the register
33 61C4 789E
34 61C6 06C0 swpb r0 ; swap it back again
35 61C8 0580 inc r0 ; add 1 to register
36 61CA 0601 dec r1 ; finished?
37 61CC 16F8 jne ldvdpl ; repeat if not
38 ; set XMAX...
39 61CE D012 movb *r2,r0 ; get xmax
40 61D0 0880 sra r0,8 ; move to low byte
41 61D2 C800 mov r0,@xmax ; set xmax
41 61D4 A02C
42 61D6 05C7 inct r7 ; point to vdp r1 data
43 61D8 D817 movb *r7,@>83d4 ; write vdp r1 to >83d4
43 61DA 83D4
44 61DC D817 movb *r7,@VDPR1 ; save copy
44 61DE A06C
45 ; now clear the screen...
46 61E0 C060 mov @xmax,r1 ; calculate the character count
46 61E2 A02C
47 61E4 0200 li r0,24 ; according to the...
47 61E6 0018
48 61E8 3840 mpy r0,r1 ; ...text mode
49 61EA 04C0 clr r0 ; screen address
50 61EC 0201 li r1,>2000 ; space character
50 61EE 2000
51 61F0 06A0 bl @vsbwmi ; wipe screen
51 61F2 7880
52 61F4 04E0 clr @scrX ; zero x coordinate
52 61F6 A028
53 61F8 04E0 clr @scrY ; zero y coordinate
53 61FA A02A
54 61FC 0288 ci r8,1 ; was 32 column mode selected?
54 61FE 0001
55 6200 1613 jne gmodex ; if not, then exit
56 ; load colour table for pattern mode...
57 6202 0200 li r0,>380 ; color table
57 6204 0380
58 6206 0201 li r1,>f000 ; white on transparent
58 6208 F000
59 620A 0202 li r2,16 ; count
59 620C 0010
60 620E 06A0 bl @vsbwmi ; load colour table
60 6210 7880
61 ; initialise sprite attribute list...
62 6212 0200 li r0,>303 ; address of colour byte
62 6214 0303
63 6216 04C1 clr r1 ; transparent colour
64 6218 0202 li r2,32 ; 32 sprites
64 621A 0020
65 621C 06A0 dovdp2 bl @_vsbw0 ; write to sprite
65 621E 782C
66 6220 0220 ai r0,4 ; move to next sprite
66 6222 0004
67 6224 0602 dec r2 ; decrement count
68 6226 16FA jne dovdp2 ; repeat if not finished
69 6228 1017 gmodex jmp gexit
70 col40d ; register count and data
71 622A 0800 byte 8,>00,>f0,>00,>0e,>01,>06,>00,>f4
71 622C F000
71 622E 0E01
71 6230 0600
71 6232 F4
72 6233 28 byte 40 ; XMAX
73 col32d ; register count and data
74 6234 0800 byte 8,>00,>e0,>00,>0e,>01,>06,>02,>f4
74 6236 E000
74 6238 0E01
74 623A 0602
74 623C F4
75 623D 20 byte 32 ; XMAX
76 col80d ; register count and data
77 623E 0F04 byte 15,>04,>70,>03,>e8,>01,>06,>00,>f4,>88,>00,>00,>00,>94,>10,>00
77 6240 7003
77 6242 E801
77 6244 0600
77 6246 F488
77 6248 0000
77 624A 0094
77 624C 1000
78 624E 50 byte 80 ; XMAX
79 624F 0000 even
80 ;]
81
82 ;[ HCHAR ( y x ascii count -- )
83 6250 06A0 _hchar bl @get4 ; get parameters from stack and calculate
83 6252 6592
84 ; screen address
85 6254 06A0 bl @_vsbwm ; write to screen
85 6256 7872
86 6258 0460 gexit b @retB0
86 625A 833A
87 ;]
88
89 ;[ VCHAR ( y x ascii count -- )
90 625C 06A0 _vchar bl @get4 ; get parameters from stack and calculate
90 625E 6592
91 ; screen address
92 6260 0206 li r6,24 ; row count
92 6262 0018
93 6264 39A0 mpy @xmax,r6 ; max visible address+1 (in r7)
93 6266 A02C
94 6268 0607 dec r7 ; correct max visible (we count from 0)
95 626A C1A0 mov @xmax,r6 ; get xmax in a register
95 626C A02C
96 626E 06A0 vchar1 bl @_vsbw ; write a character
96 6270 781E
97 6272 A006 a r6,r0 ; move down one line
98 6274 81C0 c r0,r7 ; gone off end of screen?
99 6276 1201 jle vchar2 ; skip if not
100 6278 6007 s r7,r0 ; reduce address
101 627A 0602 vchar2 dec r2 ; decrement count
102 627C 16F8 jne vchar1 ; repeat if not finished
103 627E 10EC jmp gexit
104 ;]
105
106 ;[ GCHAR ( y x -- ascii )
107 6280 06A0 _gchar bl @get2 ; get y & x from stack
107 6282 659A
108 6284 39A0 mpy @xmax,r6 ; compute y
108 6286 A02C
109 6288 A007 a r7,r0 ; compute screen address
110 628A 04C1 clr r1 ; use r1 for byte operations
111 628C 06A0 bl @_vsbr ; read byte from vdp
111 628E 77E4
112 6290 06C1 swpb r1 ; move byte to lsb
113 6292 0644 dect stack ; make space on stack
114 6294 C501 mov r1,*stack ; place on stack as 16 bit word
115 6296 10E0 jmp gexit
116 ;]
117
118 ;[ DCHAR ( address count ascii -- )
119 ; Equivalent to CALL CHAR in BASIC.
120 ; Used to define a character.
121 ; Moves count words from address to ascii address in VDP memory
122 6298 06A0 _dchar bl @sget3 ; get 3 parameters
122 629A 658A
123 629C C249 mov r9,r9 ; if count=0 then...
124 629E 13DC jeq gexit ; ...just exit
125 62A0 C008 mov r8,r0 ; ascii
126 62A2 0A30 sla r0,3 ; multiply by 8
127 62A4 0220 ai r0,>800 ; add pattern table offset
127 62A6 0800
128 62A8 C04A mov r10,r1 ; source address
129 62AA C089 mov r9,r2 ; count
130 62AC 0A12 sla r2,1 ; convert from words to bytes
131 62AE 06A0 bl @_vmbw ; write to vdp
131 62B0 7846
132 62B2 10D2 jmp gexit
133 ;]
134
135 ;[ SPRITE ( sprite y x ascii color -- )
136 ; sprite attribute list begins at 6*80h=300h
137 62B4 06A0 _sprit bl @sget5 ; get 5 parameters
137 62B6 6586
138 62B8 0A2A sla r10,2 ; multiply sprite by 4 (offset into SAL)
139 62BA 020B li r11,sal ; address of SAL in CPU ram
139 62BC A088
140 62BE 0200 li r0,>300 ; address of SAL in VDP ram
140 62C0 0300
141 62C2 A2CA a r10,r11 ; add offset to cpu addr according to
142 ; sprite number
143 62C4 C04B mov r11,r1 ; cpu source for vmbw
144 62C6 A00A a r10,r0 ; destination address for vmbw
145 62C8 06C6 swpb r6 ; rotate colour
146 62CA 06C7 swpb r7 ; rotate ascii
147 62CC 06C8 swpb r8 ; rotate x
148 62CE 06C9 swpb r9 ; rotate y
149 62D0 DEC9 movb r9,*r11+ ; move y to cpu buffer
150 62D2 DEC8 movb r8,*r11+ ; move x to cpu buffer
151 62D4 DEC7 movb r7,*r11+ ; move ascii to cpu buffer
152 62D6 DEC6 movb r6,*r11+ ; move colour to cpu buffer
153 62D8 0202 li r2,4
153 62DA 0004
154 62DC 06A0 bl @_vmbw
154 62DE 7846
155 62E0 0460 sprtx b @retB0
155 62E2 833A
156 ;]
157
158 ;[ MAGNIFY ( x -- )
159 ; sets sprite magnification:
160 ; only the least significant bits are used:
161 ; bit 7: 1=magnified (0=not magnified)
162 ; bit 6: 1=double size (4 character)
163 ; Remember: TI number their bits backwards! Idiots!
164 62E4 C2B4 _magfy mov *stack+,r10 ; pop x
165 62E6 06CA swpb r10 ; get value in msb
166 62E8 024A andi r10,>0300 ; mask out any crap
166 62EA 0300
167 62EC 0200 li r0,>0001 ; vdp register number in lsb
167 62EE 0001
168 62F0 04C2 clr r2 ; prepare for byte operations
169 62F2 D0A0 movb @VDPR1,r2 ; get copy of VDP R1
169 62F4 A06C
170 62F6 0242 andi r2,>fc00 ; mask out magnification bits
170 62F8 FC00
171 62FA F282 socb r2,r10 ; OR in new magnification value
172 62FC D00A movb r10,r0 ; place in r0 msb
173 62FE D800 movb r0,@>83d4 ; place copy in 83d4
173 6300 83D4
174 6302 D800 movb r0,@VDPR1 ; reserve copy (VDP regs are read only)
174 6304 A06C
175 6306 06C0 swpb r0 ; rotate
176 6308 06A0 bl @_vwtr ; set the register
176 630A 789E
177 630C 10E9 jmp sprtx
178 ;]
179
180 ;[ SPRCOL ( sprite# colour -- )
181 ; sets the colour of a sprite
182 630E C274 _spcol mov *stack+,r9 ; pop colour
183 6310 C2B4 mov *stack+,r10 ; pop sprite#
184 6312 0200 li r0,>300+3 ; SAL in vdp (offset to colour byte added)
184 6314 0303
185 6316 0208 li r8,SAL+3 ; SAL in CPU (offset to colour byte added)
185 6318 A08B
186 631A 0A2A sla r10,2 ; multiply sprite number by 4
187 631C A00A a r10,r0 ; point to correct address in vdp
188 631E A20A a r10,r8 ; point to correct address in CPU SAL
189 6320 06C9 swpb r9 ; rotate colour into MSB
190 6322 C049 mov r9,r1 ; into r1 for VSBW
191 6324 D609 movb r9,*r8 ; load into CPU SAL
192 6326 06A0 bl @_vsbw ; write colour byte into VDP
192 6328 781E
193 632A 10DA jmp sprtx
194 ;]
195
196 ;[ SPRLOC ( sprite y x -- )
197 ; sets the location of a sprite
198 632C 06A0 _sploc bl @sget3 ; get 3 parameters from stack
198 632E 658A
199 6330 0200 li r0,>300 ; address of SAL in VDP
199 6332 0300
200 6334 0201 li r1,SAL ; address of SAL in CPU
200 6336 A088
201 6338 0A2A sla r10,2 ; get offset into tables
202 633A A00A a r10,r0 ; add to vdp addr
203 633C A04A a r10,r1 ; add to cpu addr
204 633E 06C8 swpb r8 ; rotate x
205 6340 06C9 swpb r9 ; rotate y
206 6342 DC49 movb r9,*r1+ ; write y to cpu SAL
207 6344 D448 movb r8,*r1 ; write x to cpu SAL
208 6346 0601 dec r1 ; point to beginning of entry in SAL
209 6348 0202 li r2,2 ; two bytes to write
209 634A 0002
210 634C 06A0 bl @_vmbw ; write to VDP
210 634E 7846
211 6350 10C7 jmp sprtx
212 ;]
213
214 ;[ SPRLOC? ( sprite -- y x )
215 ; gets the location of a sprite
216 6352 C294 _spget mov *stack,r10 ; pop sprite#
217 6354 0200 li r0,sal ; address of SAL in CPU ram
217 6356 A088
218 6358 0A2A sla r10,2 ; get offset
219 635A A00A a r10,r0 ; point to correct address in SAL
220 635C 04C1 clr r1 ; prepare for byte operations
221 635E D070 movb *r0+,r1 ; get y and point to x
222 6360 06C1 swpb r1 ; move to lsb
223 6362 C501 mov r1,*stack ; place on stack
224 6364 0644 dect stack ; make new stack entry
225 6366 04C1 clr r1
226 6368 D050 movb *r0,r1 ; get x
227 636A 06C1 swpb r1 ; move to lsb
228 636C C501 mov r1,*stack ; place on stack
229 636E 10B8 jmp sprtx
230 ;]
231
232 ;[ SPRPAT ( sprite# ascii -- )
233 ; sets the pattern of a sprite
234 6370 C274 _sppat mov *stack+,r9 ; pop ascii
235 6372 C2B4 mov *stack+,r10 ; pop sprite#
236 6374 0200 li r0,>300+2 ; address of SAL in vdp
236 6376 0302
237 6378 0202 li r2,SAL+2 ; address of SAL in cpu
237 637A A08A
238 637C 0A2A sla r10,2 ; calculate offset
239 637E A00A a r10,r0 ; offset into vdp
240 6380 A08A a r10,r2 ; offset into cpu
241 6382 06C9 swpb r9 ; rotate ascii into msb
242 6384 C049 mov r9,r1 ; for vsbw
243 6386 D489 movb r9,*r2 ; set in cpu ram
244 6388 06A0 bl @_vsbw ; set in vdp ram
244 638A 781E
245 638C 10A9 jmp sprtx
246 ;]
247
248 ;[ SPRVEC ( sprite y x -- )
249 ; sets the Y and X movement offsets for sprite movement with SPRMOV
250 638E 06A0 _smlst bl @sget3 ; get 3 parameters
250 6390 658A
251 6392 0200 li r0,smlist ; address of sprite movement list
251 6394 A108
252 6396 0A1A sla r10,1 ; multiply sprite number by 2
253 6398 A00A a r10,r0 ; r0=address of appropriate entry in smlist
254 ; table.
255 639A 06C9 swpb r9 ; get y in MSB
256 639C 06C8 swpb r8 ; get x in MSB
257 639E DC09 movb r9,*r0+ ; load y into smlist
258 63A0 D408 movb r8,*r0 ; load x into smlist
259 63A2 109E jmp sprtx
260 ;]
261
262 ;[ SPRMOV ( start_sprite number_of_sprites -- )
263 ; moves sprites according to the entries in SMLIST, starting from start_sprite
264 ; and continuing for number_of_sprites
265 ;
266 ; UPDATED MARCH 2012 SO THAT ONLY SPRITES WHO HAVE THEIR COORDINATES CHANGED
267 ; ARE ACTUALLY UPDATED IN VDP
268 63A4 C274 _spmov mov *stack+,r9 ; pop number of sprites
269 63A6 C2B4 mov *stack+,r10 ; pop start sprite
270 63A8 0749 abs r9 ; force positive & compare to zero. Nice.
271 63AA 139A jeq sprtx ; just exit if number of sprites=0
272 63AC C089 mov r9,r2 ; save no. of sprites to move in r2
273 63AE C2CA mov r10,r11 ; copy start sprite
274 63B0 C18A mov r10,r6 ; copy again
275 63B2 0A1A sla r10,1 ; adjust for start sprite smlist
276 63B4 022A ai r10,smlist ; point to correct entry in smlist
276 63B6 A108
277 63B8 0A2B sla r11,2 ; adjust destination for sal
278 63BA 022B ai r11,sal ; point to correct entry in the sal
278 63BC A088
279 63BE BEFA sprmv1 ab *r10+,*r11+ ; add y
280 63C0 BEFA ab *r10+,*r11+ ; add x
281 63C2 05CB inct r11 ; skip ascii code and colour in sal
282 63C4 0609 dec r9 ; decrement count
283 63C6 16FB jne sprmv1 ; repeat if not finished
284 63C8 0200 li r0,>300 ; vdp address of sal
284 63CA 0300
285 63CC 0A26 sla r6,2 ; calculate offset into sal
286 63CE A006 a r6,r0 ; calculate vdp sal address
287 63D0 0201 li r1,sal ; cpu address of sal
287 63D2 A088
288 63D4 A046 a r6,r1 ; calculate cpu source address of sal
289 63D6 0A22 sla r2,2 ; calculate number of bytes to write
290 63D8 06A0 bl @_vmbw ; copy cpu sal to vdp sal
290 63DA 7846
291 63DC 100B jmp gexit1
292 ;]
293
294 ;[ COLOR ( char_set foreground background -- )
295 ; sets the color sets in 32 column mode
296 63DE 06A0 _color bl @sget3 ; get 3 parameters
296 63E0 658A
297 63E2 0200 li r0,>380 ; address of colour table
297 63E4 0380
298 63E6 A00A a r10,r0 ; point to correct colour set entry
299 63E8 0A49 sla r9,4 ; move foreground into ms nybble
300 63EA E209 soc r9,r8 ; OR foreground into background
301 63EC C048 mov r8,r1 ; move to r1 for vsbw
302 63EE 06C1 swpb r1 ; move to ms byte
303 63F0 06A0 bl @_vsbw0 ; write to vdp
303 63F2 782C
304 63F4 0460 gexit1 b @retB0
304 63F6 833A
305 ;]
306
307 ;[ SCREEN ( colour -- )
308 ; sets the screen colour
309 63F8 C2B4 _scren mov *stack+,r10 ; pop colour
310 63FA 0200 li r0,>0700 ; vdp register number
310 63FC 0700
311 63FE 024A andi r10,>00ff ; mask out any crap
311 6400 00FF
312 6402 E00A soc r10,r0 ; or colour into register
313 6404 06A0 bl @_vwtr
313 6406 789E
314 6408 10F5 jmp gexit1
315 ;]
316
317 ;[ SCROLL ( direction -- )
318 ; scrolls the screen, according to the coodinates in PANEL
319 ; 0=left 2=right 4=up 6=down
320 ; I'm not happy with these routines. I'm sure they could be shorter and faster
321 ; I'll have to revisit them later.
322 _scrol
323 640A C260 mov @panxy,r9 ; screen address to start
323 640C A032
324 640E C1A0 mov @panc,r6 ; column count
324 6410 A036
325 6412 C1E0 mov @panr,r7 ; row count
325 6414 A034
326 6416 0208 li r8,>2000 ; space character (used if no wrap around)
326 6418 2000
327 641A C2A0 mov @wrap,r10 ; get WRAP in a register
327 641C A030
328 641E C3E0 mov @xmax,r15 ; get xmax in a register
328 6420 A02C
329 6422 C820 mov @bank1_,@retbnk ; interrupts should return to bank 1
329 6424 606C
329 6426 A06E
330 ; check direction and call appropriate routine...
331 6428 0200 li r0,scrlut ; address of look up table
331 642A 6432
332 642C A034 a *stack+,r0 ; add and pop parameter to get address of
333 ; routine.
334 642E C010 mov *r0,r0 ; get the address in a register
335 6430 0450 b *r0 ; call the routine
336 6432 643A scrlut data _left,_right,_up,_down ; addresses of the routines to call
336 6434 6478
336 6436 64BE
336 6438 6512
337
338 ;[ ; left scroll...
339 _left ; read a line from screen into buffer...
340 643A C009 mov r9,r0 ; vdp address
341 643C C086 mov r6,r2 ; number of bytes to read
342 643E C060 mov @here,r1 ; cpu buffer
342 6440 A046
343 6442 06A0 bl @_vmbr2 ; read a line
343 6444 77FE
344 6446 C020 mov @here,r0 ; start of buffer
344 6448 A046
345 644A C040 mov r0,r1 ; one character to the right
346 644C 0581 inc r1 ; one character to the right
347 644E C28A mov r10,r10 ; check WRAP
348 6450 1602 jne _lwrap ; jump if true (wrap=on)
349 6452 D388 movb r8,r14 ; else load a space character for the
350 ; wrap-around.
351 6454 1001 jmp $+4 ; skip next instruction
352 6456 D390 _lwrap movb *r0,r14 ; save leftmost char for wrap around
353 6458 C086 mov r6,r2 ; x count
354 645A 0602 dec r2 ; point to end of line for wrap-around
355 645C DC31 _left1 movb *r1+,*r0+ ; copy character to the left
356 645E 0602 dec r2 ; reduce x count
357 6460 16FD jne _left1 ; loop if not finished
358 6462 D40E movb r14,*r0 ; copy saved character for wrap around
359 6464 C009 mov r9,r0 ; set screen address
360 6466 C060 mov @here,r1 ; source
360 6468 A046
361 646A C086 mov r6,r2 ; count
362 646C 06A0 bl @_vmbw2 ; write to screen
362 646E 784C
363 6470 0607 dec r7 ; finished?
364 6472 13C0 jeq gexit1 ; if so exit
365 6474 A24F a r15,r9 ; move down one line
366 6476 10E1 jmp _left ; repeat
367 ;]
368
369 ;[ ; right scroll...
370 _right ; read a line from screen into buffer...
371 6478 C009 mov r9,r0 ; vdp address
372 647A C086 mov r6,r2 ; number of bytes to read
373 647C C060 mov @here,r1 ; cpu buffer
373 647E A046
374 6480 06A0 bl @_vmbr2 ; read a line
374 6482 77FE
375 6484 C020 mov @here,r0 ; start of buffer
375 6486 A046
376 6488 A006 a r6,r0 ; end of buffer +1
377 648A 0600 dec r0 ; correct to point to end of buffer
378 648C C040 mov r0,r1 ; r1 will hold...
379 648E 0601 dec r1 ; ...end of buffer -1
380 6490 C28A mov r10,r10 ; check WRAP
381 6492 1602 jne _rwrap ; jump if true (wrap=on)
382 6494 D388 movb r8,r14 ; else load a space character for the
383 ; wrap-around
384 6496 1001 jmp $+4 ; skip next instruction
385 6498 D390 _rwrap movb *r0,r14 ; save leftmost char for wrap around
386 649A C086 mov r6,r2 ; x count
387 649C 0602 dec r2 ; point to end of line for wrap-around
388 649E D411 _right1 movb *r1,*r0 ; copy character to the left
389 64A0 0600 dec r0 ; decrement pointer
390 64A2 0601 dec r1 ; decrement pointer
391 64A4 0602 dec r2 ; reduce x count
392 64A6 16FB jne _right1 ; loop if not finished
393 64A8 D40E movb r14,*r0 ; copy saved character for wrap around
394 64AA C009 mov r9,r0 ; set screen address
395 64AC C060 mov @here,r1 ; source
395 64AE A046
396 64B0 C086 mov r6,r2 ; count
397 64B2 06A0 bl @_vmbw2 ; write to screen
397 64B4 784C
398 64B6 0607 dec r7 ; finished?
399 64B8 139D jeq gexit1 ; if so exit
400 64BA A24F a r15,r9 ; move down one line
401 64BC 10DD jmp _right ; repeat
402 ;]
403
404 ;[ ; up scroll...
405 64BE C28A _up mov r10,r10 ; check wrap
406 64C0 1306 jeq _up0 ; jump if no wrap
407 64C2 C009 mov r9,r0 ; top left address
408 64C4 C086 mov r6,r2 ; x count
409 64C6 0201 li r1,tib ; we'll use the terminal input buffer for storage
409 64C8 3420
410 64CA 06A0 bl @_vmbr2 ; read the liine
410 64CC 77FE
411 64CE C009 _up0 mov r9,r0 ; top left screen address to r0
412 64D0 A00F _up1 a r15,r0 ; move down one line
413 64D2 C060 mov @here,r1 ; buffer address
413 64D4 A046
414 64D6 C086 mov r6,r2 ; x count
415 64D8 06A0 bl @_vmbr2 ; read from screen
415 64DA 77FE
416 64DC 600F s r15,r0 ; move up a line
417 64DE C060 mov @here,r1 ; buffer address
417 64E0 A046
418 64E2 C086 mov r6,r2 ; number of bytes to write (x count)
419 64E4 06A0 bl @_vmbw2 ; write them
419 64E6 784C
420 64E8 0607 dec r7 ; decrement counter
421 64EA 1302 jeq _up2 ; exit if finished
422 64EC A00F a r15,r0 ; move down a line
423 64EE 10F0 jmp _up1 ; repeat
424 64F0 C28A _up2 mov r10,r10 ; check wrap
425 64F2 1306 jeq _up3 ; blank line if not required
426 64F4 0201 li r1,tib ; else get ready to write the buffered line
426 64F6 3420
427 64F8 C086 mov r6,r2 ; x count
428 64FA 06A0 bl @_vmbw2 ; write it
428 64FC 784C
429 64FE 1005 jmp _upout ; see ya
430 6500 0201 _up3 li r1,>2000 ; write a blank line
430 6502 2000
431 6504 C086 mov r6,r2 ; x count
432 6506 06A0 bl @_vsbwm2 ; write it
432 6508 7878
433 650A 04E0 _upout clr @tib ; clear tib
433 650C 3420
434 650E 0460 gexit2 b @retB0
434 6510 833A
435 ;]
436
437 ;[ ; down scroll...
438 6512 0607 _down dec r7
439 6514 C007 mov r7,r0 ; y length
440 6516 380F mpy r15,r0 ; convert to address (result in r1)
441 6518 A049 a r9,r1 ; add top of panel offset
442 651A C001 mov r1,r0 ; vdp address in r0
443 651C C28A mov r10,r10 ; check wrap
444 651E 1305 jeq _down0 ; skip if not required
445 6520 0201 li r1,tib ; we'll use the terminal input buffer for
445 6522 3420
446 ; storage
447 6524 C086 mov r6,r2 ; x count
448 6526 06A0 bl @_vmbr2 ; read the line
448 6528 77FE
449 652A 600F _down0 s r15,r0 ; move up a line
450 652C C060 mov @here,r1 ; buffer address
450 652E A046
451 6530 C086 mov r6,r2 ; x count
452 6532 06A0 bl @_vmbr2 ; read a line
452 6534 77FE
453 6536 A00F a r15,r0 ; move down a line
454 6538 C060 mov @here,r1 ; buffer address
454 653A A046
455 653C C086 mov r6,r2 ; x count
456 653E 06A0 bl @_vmbw2 ; write it
456 6540 784C
457 6542 0607 dec r7 ; decrement line count
458 6544 1302 jeq _down1 ; jump if finished
459 6546 600F s r15,r0 ; otherwise move up a line
460 6548 10F0 jmp _down0 ; and repeat
461 654A 600F _down1 s r15,r0 ; up a line
462 654C C28A mov r10,r10 ; check wrap
463 654E 1306 jeq _down2 ; blank line if not required
464 6550 0201 li r1,tib ; source
464 6552 3420
465 6554 C086 mov r6,r2 ; x count
466 6556 06A0 bl @_vmbw2 ; write saved line
466 6558 784C
467 655A 1005 jmp _dnout ; see ya
468 655C 0201 _down2 li r1,>2000 ; write a blank line
468 655E 2000
469 6560 C086 mov r6,r2 ; x count
470 6562 06A0 bl @_vsbwm2 ; write it
470 6564 7878
471 6566 04E0 _dnout clr @tib ; clear tib
471 6568 3420
472 656A 10D1 jmp gexit2
473 ;]
474 ;]
475
476 ;[ PANEL ( x y xl yl -- )
477 ; defines a screen panel to be used by SCROLL
478 _panel
479 656C 06A0 bl @sget4 ; get 4 parameters off stack
479 656E 6588
480 6570 C009 mov r9,r0 ; move y
481 6572 3820 mpy @xmax,r0 ; multiply y by line length
481 6574 A02C
482 6576 A04A a r10,r1 ; add x
483 6578 C801 mov r1,@panxy ; save it
483 657A A032
484 657C C807 mov r7,@panr ; save yl
484 657E A034
485 6580 C808 mov r8,@panc ; save xl
485 6582 A036
486 6584 10C4 jmp gexit2
487 ;]
488
489 ;[
490 ; subroutine to get parameters off the stack
491 6586 C1B4 sget5 mov *stack+,r6
492 6588 C1F4 sget4 mov *stack+,r7
493 658A C234 sget3 mov *stack+,r8
494 658C C274 mov *stack+,r9
495 658E C2B4 mov *stack+,r10
496 6590 045B rt
497 ;]
498
499 ;[
500 ; subroutine to get parameters off the stack for HCHAR VCHAR and GCHAR
501 ; Has two entry points:
502 ; get4: gets four parameters (HCHAR & VHCAR)
503 ; get2: gets two parameters (GCHAR)
504 6592 C0B4 get4 mov *stack+,r2 ; pop count
505 6594 1308 jeq gabort ; if count=0 then cancel the instruction
506 6596 C074 mov *stack+,r1 ; pop ascii
507 6598 06C1 swpb r1 ; move to high byte
508 659A C034 get2 mov *stack+,r0 ; pop x
509 659C C1B4 mov *stack+,r6 ; pop y
510 659E 39A0 mpy @xmax,r6 ; multiply by screen size
510 65A0 A02C
511 65A2 A007 a r7,r0 ; calculate screen start address
512 65A4 045B rt
513 65A6 0224 gabort ai stack,6 ; pop remaining parameters off the stack
513 65A8 0006
514 65AA 0460 b @retB0 ; and just exit
514 65AC 833A
515 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-04-Memory.a99'
*
1 ; __ __
2 ; | \/ | /\
3 ; | \ / | ___ _ __ ___ ___ _ __ _ _ / \ ___ ___ ___ ___ ___
4 ; | |\/| |/ _ \ '_ ` _ \ / _ \| '__| | | | / /\ \ / __|/ __|/ _ | __/ __|
5 ; | | | | __/ | | | | | (_) | | | |_| | / ____ \ (__| (__| __|__ \__ \
6 ; |_| |_|\___|_| |_| |_|\___/|_| \__, | /_/ \_\___|\___|\___|___/___/
7 ; Memory access words __/ |
8 ; |___/
9 ;[ FILL ( addr count value -- )
10 65AE 06A0 _fill bl @sget3 ; get 3 parameters
10 65B0 658A
11 65B2 C249 mov r9,r9 ; if value=0 then...
12 65B4 131A jeq cmvext ; ...just exit
13 65B6 06C8 swpb r8 ; get byte value in msb
14 65B8 DE88 filllp movb r8,*r10+ ; move to addr and increment addr
15 65BA 0609 dec r9 ; finished?
16 65BC 16FD jne filllp ; repeat if not
17 65BE 1015 jmp cmvext ; clean up and exit
18 ;]
19
20 ;[ CMOVE ( addr1 addr2 count -- )
21 ; Move count bytes beginning at address addr1 to addr2. The byte at addr1 is
22 ; moved first, proceeding toward high memory. If count is zero nothing is moved
23 65C0 06A0 _cmove bl @sget3 ; get 3 parameters
23 65C2 658A
24 65C4 C208 mov r8,r8 ; if count=0 then...
25 65C6 1311 jeq cmvext ; ...just exit
26 65C8 DE7A cmovlp movb *r10+,*r9+ ; move a byte
27 65CA 0608 dec r8 ; finished?
28 65CC 16FD jne cmovlp ; repeat if not
29 65CE 100D jmp cmvext ; clean up and exit
30 ;]
31
32 ;[ CMOVE> ( addr1 addr2 count -- )
33 ; Move the count bytes at address addr1 to addr2. The move begins by moving the
34 ; byte at addr1 plus count minus 1 to addr2 plus count minus 1 and proceeds to
35 ; successively lower addresses for count bytes.
36 ; If count is zero nothing is moved.
37 ; (Useful for sliding a string towards higher addresses)
38 65D0 06A0 _cmovf bl @sget3 ; get 3 parameters
38 65D2 658A
39 65D4 C208 mov r8,r8 ; if count=0 then...
40 65D6 1309 jeq cmvext ; ...just exit
41 65D8 0608 dec r8 ; count-1
42 65DA A248 a r8,r9 ; addr2=addr2+count-1
43 65DC A288 a r8,r10 ; addr1=addr1+count-1
44 65DE 0588 inc r8 ; restore count
45 65E0 D65A cmvflp movb *r10,*r9 ; move a byte
46 65E2 060A dec r10 ; decrement addr 1
47 65E4 0609 dec r9 ; decrement addr 2
48 65E6 0608 dec r8 ; decrement count
49 65E8 16FB jne cmvflp ; loop if not finished
50 65EA 0460 cmvext b @retB0
50 65EC 833A
51 ;]
52
53 ;[ COPYW (source destination count -- )
54 ; copy WORDS from source to destination for 'count' words
55 ; no action taken if count=0
56 65EE 06A0 _copyw bl @sget3
56 65F0 658A
57 65F2 C208 mov r8,r8 ; if count=0 then...
58 65F4 13FA jeq cmvext ; ...just exit
59 65F6 CE7A copywl mov *r10+,*r9+ ; copy a word
60 65F8 0608 dec r8 ; decrement counter
61 65FA 16FD jne copywl ; loop if counter not zero
62 65FC 10F6 jmp cmvext ; clean up and exit
63 ;]
64
65 ;[ ; >MAP ( bank address -- )
66 ; If a SAMS card is present, maps memory bank "bank" to address "address"
67 65FE C2CC _sams mov r12,r11 ; save address of NEXT
68 6600 C074 mov *stack+,r1 ; get address
69 6602 0241 andi r1,>f000 ; set to 4k boundary
69 6604 F000
70 6606 09B1 srl r1,11 ; divide by 2048
71 6608 0221 ai r1,>4000 ; convert to SAMS register address
71 660A 4000
72 660C C0B4 mov *stack+,r2 ; get bank
73 660E 0242 andi r2,>ff ; mask off any crap
73 6610 00FF
74 6612 C002 mov r2,r0 ; keep a copy
75 6614 0A82 sla r2,8 ; move to high byte
76 6616 2880 xor r0,r2 ; combine r0 & r2. Hi & lo bytes are now identical
77 6618 020C li r12,>1e00 ; cru address of SAMS
77 661A 1E00
78 661C 1D00 sbo 0 ; enable SAMS registers
79 661E C442 mov r2,*r1 ; poke sams register
80 6620 1E00 sbz 0 ; disable sams registers
81 6622 C30B mov r11,r12 ; restore address of NEXT
82 6624 0460 b @retB0 ; return to caller
82 6626 833A
83
84 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-05-Speech.a99'
*
1 ; _____ _ __ __ _
2 ; / ____| | | \ \ / / | |
3 ; | (___ _ __ ___ ___ ___| |__ \ \ /\ / /___ _ __ __| |___
4 ; \___ \| '_ \ / _ \/ _ \/ __| '_ \ \ \/ \/ // _ \| '__/ _` / __|
5 ; ____) | |_) | __/ __/ (__| | | | \ /\ /| (_) | | | (_| \__ \
6 ; |_____/| .__/ \___|\___|\___|_| |_| \/ \/ \___/|_| \__,_|___/
7 ; | |
8 ; |_|
9
10 0000 9000 spchrd equ >9000 ; speech read register
11 0000 9400 spchwt equ >9400 ; speech write register
12
13 6628 10 spread byte 16 ; 'read data' command code
14 6629 AA ssflag byte >aa ; 'speech synth present' check code
15 662A 50 spkROM byte >50 ; 'speak from ROM' command code
16 662B 0000 even
17
18 ;[ TALKING? ( -- flag )
19 ; returns 0 if speech synth is idle, else returns 1
20 ; Upon testing, it appears that the synth reports idle *just before* it really
21 ; is finished.
22 ; This causes a problem, as TurboForth is fast enough to start feeding new data
23 ; immediately when it detects the synth as idle, thus chopping off the end of
24 ; streamed speech.
25 ; To protect against this, it uses the hardware busy signal from the synth,
26 ; *and* the number of bytes/words currently outstanding in any data that is
27 ; currently being fed to the synth. If either>0 then a busy is returned.
28 662C 0644 _spkng dect stack ; make space on data stack
29 662E C020 mov @synyes,r0 ; synth fitted?
29 6630 A040
30 6632 130B jeq nspk ; if not then just return 'not speaking'
31 6634 06A0 bl @spstat ; else get status from speech synth
31 6636 8340
32 6638 C020 mov @spdata,r0 ; get the data from speech synth
32 663A 834A
33 663C 0240 andi r0,>8000 ; isolate busy bit
33 663E 8000
34 6640 A020 a @spcnt,r0 ; add words/bytes remaining in speech buffer
34 6642 A03A
35 6644 1302 jeq nspk ; not speaking
36 6646 0714 seto *stack ; speaking
37 6648 100D jmp sayxit ; return via r15
38 664A 04D4 nspk clr *stack ; not speaking
39 664C 100B jmp sayxit
40 ;]
41
42 ;[ SAY ( addr count -- )
43 ; feeds count words to the speech synth, starting at addr. Used to speak words
44 ; from the built in speech rom. The data fed to the synth should be the entry
45 ; addresses of speech rom words, as found in the editor assembler manual.
46 664E C834 _say mov *stack+,@spcnt ; pop speech buffer count
46 6650 A03A
47 6652 C834 mov *stack+,@spadr ; pop speech buffer address
47 6654 A03C
48 6656 C020 mov @synyes,r0 ; check if speech synth is fitted
48 6658 A040
49 665A 1304 jeq sayxit ; if not, just exit immediately
50 665C 0200 li r0,romspk ; else get address of rom-speak routine
50 665E 60FA
51 6660 C800 mov r0,@spcsvc ; load into speech service routine pointer
51 6662 A03E
52 6664 0460 sayxit b @retB0
52 6666 833A
53 ;]
54
55 ;[ STREAM ( addr count -- )
56 ; feeds addr bytes to the speech synth, starting at addr. Used to stream raw
57 ; speech data to the speech synth.
58 6668 C034 _strem mov *stack+,r0 ; pop speech buffer count
59 666A 0A10 sla r0,1 ; convert to byte count
60 666C C800 mov r0,@spcnt ; store it
60 666E A03A
61 6670 C834 mov *stack+,@spadr ; pop speech buffer address
61 6672 A03C
62 6674 C020 mov @synyes,r0 ; check if speech synth is fitted
62 6676 A040
63 6678 13F5 jeq sayxit ; just exit if not
64 667A 0200 li r0,strspk ; else get address of stream-speak routine
64 667C 6090
65 ; (defined in 1-01-ISR.a99)
66 667E C800 mov r0,@spcsvc ; load into speech service routine pointer
66 6680 A03E
67 6682 10F0 jmp sayxit
68 ;]
69
70 ;[ speech support routines
71 ; routine to see if speech synth is fitted
72 ; on exit sets r0: 0=not detected >ffff=detected
73 6684 04E0 isspch clr @synyes ; assume no speech synth detected
73 6686 A040
74 6688 04C0 clr r0 ; check address 0 in speech synth
75 668A 06A0 bl @readsp ; read byte from the speech synth in r0 msb
75 668C 669C
76 668E 9800 cb r0,@ssflag ; is the speech synth here?
76 6690 6629
77 6692 1301 jeq spyes ; speech synth is detected
78 6694 10E7 jmp sayxit ; see ya
79 6696 0720 spyes seto @synyes ; found speech synth
79 6698 A040
80 669A 10E4 spchx jmp sayxit ; gtf outta here
81
82
83 ; routine to read a byte from the speech synth
84 ; Inputs: R0=address in speech synth to read
85 ; Outputs R0=byte read from speech synth in MSB
86 669C C20B readsp mov r11,r8 ; save return address
87 669E 06A0 bl @spaddr ; load address into speech synth (in r0)
87 66A0 66B2
88 66A2 D820 movb @spread,@spchwt ; send read data command
88 66A4 6628
88 66A6 9400
89 66A8 0BC0 src r0,12 ; 12uS delay
90 66AA 04C0 clr r0 ; prepare for byte operations
91 66AC D020 movb @spchrd,r0 ; read the byte from the speech synth
91 66AE 9000
92 66B0 0458 b *r8 ; return to caller
93
94
95 ; routine to load an address into the speech synth's address register
96 ; the address to load is passed in r0
97 66B2 0202 spaddr li r2,4 ; 4 nybbles to load
97 66B4 0004
98 66B6 0B40 loadlp src r0,4 ; start with least significant nybble
99 66B8 C040 mov r0,r1 ; copy it
100 66BA 0B41 src r1,4 ; get target nybble into correct position
101 66BC 0241 andi r1,>0f00 ; mask out the nybble of interest
101 66BE 0F00
102 66C0 0261 ori r1,>4000 ; put in 4x00 format for speech synth
102 66C2 4000
103 66C4 D801 movb r1,@spchwt ; send it to the speech synth
103 66C6 9400
104 66C8 0602 dec r2 ; finished?
105 66CA 16F5 jne loadlp ; do next nybble repeat if not
106 66CC 0201 li r1,>4000 ; signal to speech synth that we finished...
106 66CE 4000
107 66D0 D801 movb r1,@spchwt ; ...sending the address.
107 66D2 9400
108 66D4 045B rt ; return to caller
109 ;]
110
111 ;[ (DATA) - runtime code for DATA
112 66D6 0644 _data dect stack ; make stack entry
113 66D8 C503 mov pc,*stack ; current address to stack
114 66DA 05D4 inct *stack ; plus 2
115 66DC 0644 dect stack ; stack entry
116 66DE C073 mov *pc+,r1 ; number of data items...
117 66E0 C501 mov r1,*stack ; ...to stack
118 66E2 0A11 sla r1,1 ; compute byte offset past data
119 66E4 A0C1 a r1,pc ; adjust program counter
120 66E6 0460 b @retB0
120 66E8 833A
121 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-06-Blocks.a99'
*
1 ; ____ _ _ _____ ______ __ __ _
2 ; | _ \| | | | |_ _| / / __ \ \ \ / / | |
3 ; | |_) | | ___ ___| | __ | | / / | | | \ \ /\ / /___ _ __ __| |___
4 ; | _ <| |/ _ \ / __| |/ / | | / /| | | | \ \/ \/ // _ \| '__/ _` / __|
5 ; | |_) | | (_) | (__| < _| |_ / / | |__| | \ /\ /| (_) | | | (_| \__ \
6 ; |____/|_|\___/ \___|_|\_\ |_____/_/ \____/ \/ \/ \___/|_| \__,_|___/
7 ; block file system words & subroutines
8 ; Some heavy stuff in here. In here be demons.
9 ; Turn back all ye faint of heart...
10
11 ;[ pab opcodes
12 0000 0000 open equ 0 ; open opcode
13 0000 0001 close equ >1 ; close opcode
14 0000 0002 read equ >2 ; read opcode
15 0000 0003 write equ >3 ; write opcode
16 0000 0004 fwdrew equ >4 ; restore/rewind opcode (fwd/rew)
17 0000 0009 status equ >9 ; status op-code
18 ;]
19
20 ;[ USE ( addr len -- )
21 ; Tells the system which block file to use for block IO
22 ; e.g. USE DSK1.BLOCKS
23 ; Simply sets the filename and length in the blockIO PAB
24 ; Syntax: S" DSKn.FILENAME" USE
25 66EA C0B4 _use mov *stack+,r2 ; length of filename
26 66EC 06C2 swpb r2 ; move to MSB
27 66EE C034 mov *stack+,r0 ; address of file name
28 66F0 0209 li r9,pabnln ; address of filename length in blockIO PAB
28 66F2 A189
29 66F4 DE42 movb r2,*r9+ ; write length to PAB length byte, now
30 ; pointing at filename
31 66F6 06C2 swpb r2 ; move to LSB
32 66F8 DE70 _use3 movb *r0+,*r9+ ; copy byte of filename to pab
33 66FA 0602 dec r2 ; finished copying?
34 66FC 16FD jne _use3 ; repeat if not
35 ; clear all blk pointers...
36 66FE 04E0 clr @lstblk
36 6700 A1B4
37 6702 04E0 clr @blk0
37 6704 A1B6
38 6706 04E0 clr @blk1
38 6708 A1BA
39 670A 04E0 clr @blk2
39 670C A1BE
40 670E 04E0 clr @blk3
40 6710 A1C2
41 6712 04E0 clr @blk4
41 6714 A1C6
42 6716 04E0 clr @blk5
42 6718 A1CA
43 671A 0460 usexit b @retB0
43 671C 833A
44 ;]
45
46 ;[ BLOCK ( block# -- addr )
47 ; Brings a block into a buffer, if not already in memory
48 ; 1) If already in memory, the block is not re-loaded from device
49 ; 2) If not in memory:
50 ; 3) Scans for a free buffer
51 ; 4) If no free buffer:
52 ; 5) flush all buffers back to device
53 ; 6) Repeat from 3
54 ; 7) If free buffer:
55 ; 9) Load block from device into free buffer
56 ; 10) Return address of buffer
57 ; 11) If disk error, or block not found etc, return 0
58 ; Note: If a block number of 0 is given 0 is returned
59 671E 04E0 _block clr @errnum ; clear last disk io error
59 6720 A038
60 6722 C014 mov *stack,r0 ; block number in r0 for scnblk
61 6724 13FA jeq usexit ; if zero then just exit
62 6726 C800 mov r0,@lstblk ; update last block accessed (for UPDATE)
62 6728 A1B4
63 672A 06A0 bl @scnblk ; see if the block is already in memory
63 672C 69A0
64 672E C041 mov r1,r1 ; check returned result
65 6730 1303 jeq blknim ; block is not in memory
66 6732 05C1 inct r1 ; block is in memory. point to vdp address
67 ; pointer
68 6734 C511 mov *r1,*stack ; place vdp address on stack
69 6736 10F1 jmp usexit ; exit
70 ; look for a free buffer
71 6738 06A0 blknim bl @frebuf ; block is not in memory, scan for a buffer
71 673A 6988
72 673C C000 mov r0,r0 ; check returned result
73 673E 1328 jeq bnfb ; jump if no free buffers
74 ; we have a free buffer, it's blk address is in r0...
75 6740 C414 blkfb mov *stack,*r0 ; update block indicator in block buffer
76 6742 C200 mov r0,r8 ; copy blk address
77 6744 C090 mov *r0,r2 ; copy block number
78 6746 0602 dec r2 ; reduce by one (so we can use block 0)
79 6748 0A32 sla r2,3 ; calculate record number (block no. x 8)
80 674A 05C0 inct r0 ; point to vdp address
81 674C C250 mov *r0,r9 ; save vdp address
82 674E C509 mov r9,*stack ; place vdp address on stack
83 ; put the pab into vdp ram, with an open opcode and open the file...
84 6750 0201 li r1,>8000 ; logical record length: 128 bytes (in msb)
84 6752 8000
85 6754 D801 movb r1,@pablrl ; set logical record length in pab
85 6756 A184
86 6758 C802 mov r2,@pabrec ; set record number in PAB
86 675A A186
87 675C C809 mov r9,@pabbuf ; address to load data into in VDP
87 675E A182
88 6760 06A0 bl @diskio ; witchcraft
88 6762 69B8
89 6764 0005 byte open,5 ; dis/fix input
90 6766 1319 jeq blkerr ; jump if an an error occurred
91 ; read 8 128 byte records (1K)...
92 6768 0207 li r7,8 ; 8 records to read
92 676A 0008
93 676C 06A0 blknxt bl @diskio ; call disk system
93 676E 69B8
94 6770 0205 byte read,5 ; dis/fix input
95 6772 1313 jeq blkerr ; jump if an an error occurred
96 6774 0229 ai r9,128 ; increment vdp address
96 6776 0080
97 6778 C809 mov r9,@pabbuf ; address to load data into in VDP
97 677A A182
98 677C 05A0 inc @pabrec ; set next record in PAB
98 677E A186
99 6780 0607 dec r7 ; finished reading all the records?
100 6782 16F4 jne blknxt ; repeat if not
101 6784 06A0 bl @diskio ; more alchemy
101 6786 69B8
102 6788 0105 byte close,5 ; dis/fix input
103 678A 06A0 bl @rstsp ; restore code in scratchpad
103 678C 6AEE
104 ; (destroyed by DSR access)
105 678E 10C5 jmp usexit ; exit
106 ; no free buffers :-( we need to do a flush...
107 6790 06A0 bnfb bl @flush1 ; flush all our buffers to device
107 6792 67B4
108 6794 0200 li r0,blk0 ; point to first (which is now free) block
108 6796 A1B6
109 6798 10D3 jmp blkfb ; repeat
110 ; an error occurred, return 0 on the stack
111 679A 04D4 blkerr clr *stack ; zero the TOS
112 679C 06C0 swpb r0
113 679E C800 mov r0,@errnum ; set disk io error number
113 67A0 A038
114 67A2 06A0 bl @diskio ; close the file
114 67A4 69B8
115 67A6 0105 byte close,5
116 67A8 06A0 bl @rstsp ; restore code in scratchpad
116 67AA 6AEE
117 ; (destroyed by DSR access)
118 67AC 10B6 jmp usexit ; exit
119 ;]
120
121 ;[ FLUSH ( -- )
122 ; Flushes all dirty blocks back to disk
123 ; If a blocks' DIRTY flag is set, the block is physically written back to disk.
124 ; If the block is NOT dirty, it's (BLK) status is simply set to un-used.
125 ; Sets DSKERR to reflect disk DSR error status (0=no error)
126 67AE 06A0 _flush bl @flush1
126 67B0 67B4
127 67B2 10B3 flushx jmp usexit
128 67B4 04E0 flush1 clr @errnum ; reset last disk io error
128 67B6 A038
129 67B8 C38B mov r11,r14 ; save return address of caller
130 67BA 0206 li r6,6 ; 6 buffers to check
130 67BC 0006
131 67BE 0207 li r7,blk0+2 ; start with the first vdp address pointer
131 67C0 A1B8
132 67C2 C217 flnext mov *r7,r8 ; get address
133 67C4 0248 andi r8,>8000 ; check dirty flag
133 67C6 8000
134 67C8 1325 jeq flush2 ; if 0, not dirty, just reset pointers
135 ; else flush to disk...
136 67CA 0201 li r1,>8000 ; logical record length: 128 bytes (in msb)
136 67CC 8000
137 67CE D801 movb r1,@pablrl ; set logical record length
137 67D0 A184
138 67D2 04E0 clr @pabrec ; set record number to 0
138 67D4 A186
139 67D6 06A0 bl @diskio
139 67D8 69B8
140 67DA 0001 byte open,1 ; dis/fixed update
141 67DC 132A jeq flerr ; jump if error
142 67DE 020C li r12,8 ; 8 128 byte records (1024 bytes)
142 67E0 0008
143 67E2 C217 mov *r7,r8 ; vdp address
144 67E4 0248 andi r8,>7fff ; remove dirty bit
144 67E6 7FFF
145 67E8 C067 mov @-2(r7),r1 ; get block number
145 67EA FFFE
146 67EC 0601 dec r1
147 67EE 0A31 sla r1,3 ; convert to record count
148 67F0 C801 mov r1,@pabrec ; set record number
148 67F2 A186
149 67F4 C808 flnrec mov r8,@pabbuf ; set source vdp address
149 67F6 A182
150 67F8 06A0 bl @diskio ; write the record to disk
150 67FA 69B8
151 67FC 0301 byte write,1 ; dis/fix update
152 67FE 1319 jeq flerr ; jump if error
153 6800 0228 ai r8,128 ; next 128 bytes of vdp
153 6802 0080
154 6804 05A0 inc @pabrec ; next record on disk
154 6806 A186
155 6808 060C dec r12 ; decrement counter
156 680A 16F4 jne flnrec ; loop if not finished
157 680C 06A0 bl @diskio ; close the file
157 680E 69B8
158 6810 0101 byte close,1 ; dis/fix update
159 6812 130F jeq flerr ; jump if error
160 ; reset blk & dirty flag...
161 6814 04E7 flush2 clr @-2(r7) ; clear blk indicator
161 6816 FFFE
162 6818 C057 mov *r7,r1 ; get vdp address from pointer
163 681A 0241 andi r1,>7fff ; reset dirty bit
163 681C 7FFF
164 681E C5C1 mov r1,*r7 ; write it back
165 ; loop back for remaining blks...
166 6820 0227 ai r7,4 ; point to next vdp address
166 6822 0004
167 6824 0606 dec r6 ; finished?
168 6826 16CD jne flnext ; repeat if not
169 6828 020C flexit li r12,_next ; restore pointer to NEXT
169 682A 8326
170 682C 06A0 bl @rstsp ; restore code in scratchpad (destroyed by
170 682E 6AEE
171 ; DSR access)
172 6830 045E b *r14 ; return to caller
173 ; an error occurred... exit...
174 6832 06C0 flerr swpb r0 ; move error into low byte
175 6834 C800 mov r0,@errnum ; set DSKERR with error code
175 6836 A038
176 6838 06A0 bl @diskio ; set the file to closed
176 683A 69B8
177 683C 0101 byte close,1
178 683E 10F4 jmp flexit
179 ;]
180
181 ;[ UPDATE ( -- )
182 ; marks the last accessed block as dirty so that it will subsequently be flushed
183 ; to disk.
184 6840 C020 _updat mov @lstblk,r0 ; get current block
184 6842 A1B4
185 6844 06A0 bl @scnblk ; locate it (blk address in r1)
185 6846 69A0
186 6848 05C1 inct r1 ; point to VDP address pointer
187 684A C011 mov *r1,r0 ; get the VDP address
188 684C 0260 ori r0,>8000 ; set dirty bit
188 684E 8000
189 6850 C440 mov r0,*r1 ; write it back
190 6852 10AF jmp flushx
191 ;]
192
193 ;[ EMPTY-BUFFERS ( -- )
194 ; marks all buffers as unused.
195 6854 0202 _mtbuf li r2,6 ; counter
195 6856 0006
196 6858 0200 li r0,blk0 ; address of first blk
196 685A A1B6
197 685C 04F0 mtbufl clr *r0+ ; zero block number then point to vdp
198 ; address
199 685E C050 mov *r0,r1 ; get vdp address
200 6860 0241 andi r1,>7fff ; set dirty to zero
200 6862 7FFF
201 6864 CC01 mov r1,*r0+ ; write it back, point to next blk
202 6866 0602 dec r2 ; decrement counter
203 6868 16F9 jne mtbufl ; repeat if not finished
204 686A 04E0 clr @lstblk ; no blocks in memory
204 686C A1B4
205 686E 10A1 jmp flushx
206 ;]
207
208 ;[ CLEAN ( buffer -- )
209 ; forces a buffers' status to clean
210 6870 06A0 _clean bl @cba ; compute blk address
210 6872 6978
211 6874 0241 andi r1,>7fff ; reset dirty bit
211 6876 7FFF
212 6878 C401 mov r1,*r0 ; write it back
213 687A 109B jmp flushx
214
215 ;]
216
217 ;[ DIRTY ( buffer -- )
218 ; forces a buffers' status to dirty
219 687C 06A0 _dirty bl @cba ; compute blk address
219 687E 6978
220 6880 0261 ori r1,>8000 ; set dirty bit
220 6882 8000
221 6884 C401 mov r1,*r0 ; write it back
222 6886 1095 jmp flushx
223 ;]
224
225 ;[ DIRTY? ( buffer -- flag )
226 ; interrogates a buffers' status, returning true if the buffer is dirty, else
227 ; returning false
228 6888 06A0 _qdirt bl @cba ; compute blk address
228 688A 6978
229 688C 0644 dect stack ; make space on stack (cba reduces stack
230 ; pointer)
231 688E 0241 andi r1,>8000 ; mask out everything except dirty bit
231 6890 8000
232 6892 1303 jeq ndirt ; if 0 then it's not dirty
233 6894 0714 seto *stack ; it's dirty
234 6896 0460 b @retB0
234 6898 833A
235 689A 04D4 ndirt clr *stack ; it's clean
236 689C 108A jmp flushx
237 ;]
238
239 ;[ BLK? ( buffer -- block vdp_address )
240 ; For a given buffer, returns the actual block stored in that buffer
241 ; and the vdp address of that buffer
242 689E 06A0 _blkq bl @cba ; compute blk address
242 68A0 6978
243 68A2 0644 dect stack ; make space on stack
244 68A4 0640 dect r0 ; point to blk
245 68A6 C510 mov *r0,*stack ; place on stack
246 68A8 0241 andi r1,>7fff ; mask out dirty bit
246 68AA 7FFF
247 68AC 0644 dect stack
248 68AE C501 mov r1,*stack ; place vdp address of buffer on stack
249 68B0 1080 jmp flushx
250 ;]
251
252 ;[ BUF? ( block -- buffer vdp_address )
253 ; For a given block, return the buffer number, and the vdp address of the buffer
254 ; returns 0 0 if the block is not in memory
255 68B2 C054 _buf mov *stack,r1 ; get block
256 68B4 0202 li r2,0 ; six buffers to check
256 68B6 0000
257 68B8 0200 li r0,blk0 ; point to top of buffer descriptor table
257 68BA A1B6
258 68BC 8050 bufrpt c *r0,r1 ; compare block to block being sought
259 68BE 130A jeq fndbuf ; jump if we found it
260 68C0 0220 ai r0,4 ; else point to next buffer in the table
260 68C2 0004
261 68C4 0582 inc r2 ; increment counter
262 68C6 0282 ci r2,6 ; finished?
262 68C8 0006
263 68CA 16F8 jne bufrpt
264 68CC 04D4 clr *stack ; the block was not found - return 0 0
265 68CE 0644 dect stack ; new stack entry
266 68D0 04D4 clr *stack
267 68D2 1004 jmp bufxit
268 68D4 C502 fndbuf mov r2,*stack ; push buffer number
269 68D6 0644 dect stack ; new stack entry
270 68D8 05C0 inct r0 ; point to vdp address
271 68DA C510 mov *r0,*stack ; push it to stack
272 68DC 0460 bufxit b @retB0
272 68DE 833A
273 ;]
274
275 ;[ SETBLK ( buffer block -- )
276 ; For a given buffer, changes the block that it is associated with.
277 ; Allows blocks to copied to other blocks, using FLUSH.
278 68E0 C074 _setbk mov *stack+,r1 ; pop the block
279 68E2 C0B4 mov *stack+,r2 ; pop the buffer
280 68E4 0A22 sla r2,2 ; multiply buffer by 4 to act as offset into
281 ; buffer descriptor table
282 68E6 0200 li r0,blk0 ; point to top of buffer descriptor table
282 68E8 A1B6
283 68EA A002 a r2,r0 ; point to correct entry in buffer
284 ; descriptor table
285 68EC C401 mov r1,*r0 ; change block entry
286 68EE 10F6 jmp bufxit
287 ;]
288
289 ;[ MKBLK ( filename size_in_kilobytes -- )
290 ; makes a block file on disk. Sets DSKERR with result code. >0=some error
291 68F0 04E0 _mkblk clr @errnum ; clear last disk error
291 68F2 A038
292 68F4 C034 mov *stack+,r0 ; length of file name
293 68F6 C074 mov *stack+,r1 ; address of filename
294 68F8 C1B4 mov *stack+,r6 ; pop number of kilobytes
295 68FA 06C0 swpb r0 ; get file name length in MSB
296 68FC D800 movb r0,@pabnln ; load name length byte in CPU PAB
296 68FE A189
297 6900 06C0 swpb r0
298 ; check size against limits...
299 6902 0286 ci r6,1 ; minimum size
299 6904 0001
300 6906 1104 jlt toosml ; size is too small, force to 1
301 6908 0286 ci r6,1024 ; maximum size
301 690A 0400
302 690C 1504 jgt toobig ; size is too big, force to 1024
303 690E 1005 jmp cont
304 6910 0206 toosml li r6,1 ; force size to 1
304 6912 0001
305 6914 1002 jmp cont ; continue
306 6916 0206 toobig li r6,1024 ; force size to 1024
306 6918 0400
307 ; copy the filename into the cpu ram PAB...
308 691A 0202 cont li r2,pabfil ; address of filename in CPU PAB
308 691C A18A
309 691E DCB1 mkdskl movb *r1+,*r2+ ; copy character of filename
310 6920 0600 dec r0 ; finished copying filename?
311 6922 16FD jne mkdskl
312 ; create a 128 byte block of space characters in vdp ram
313 6924 0200 li r0,recbuf ; vdp target address
313 6926 1BA0
314 6928 C800 mov r0,@pabbuf ; set vdp source buffer address
314 692A A182
315 692C 0201 li r1,>2000 ; space character
315 692E 2000
316 6930 0202 li r2,128 ; 128 bytes to write
316 6932 0080
317 6934 06A0 bl @vsbwmi ; write bytes
317 6936 7880
318 ; put the pab into vdp ram, with an open opcode. open the file, dis/fix 128
319 6938 0201 li r1,>8000 ; logical record length: 128 bytes (in msb)
319 693A 8000
320 693C D801 movb r1,@pablrl ; set logical record length
320 693E A184
321 6940 04E0 clr @pabrec ; set record number to 0
321 6942 A186
322 6944 06A0 bl @diskio
322 6946 69B8
323 6948 0003 byte open,3 ; dis/fix output
324 694A 1312 jeq mkderr ; jump if error
325 ; the file should be created at this point. now write a record:
326 ; the number of kilobytes to create is in r6
327 694C 0207 next1k li r7,8 ; number of records for 1k. 8x128 bytes=1024
327 694E 0008
328 6950 06A0 nxtrec bl @diskio ; write the pab to vdp
328 6952 69B8
329 6954 0303 byte write,3 ; dis/fix output
330 6956 130C jeq mkderr ; jump if error
331 6958 05A0 inc @pabrec ; increment record number
331 695A A186
332 695C 0607 dec r7 ; decrement record counter
333 695E 16F8 jne nxtrec ; repeat if we haven't written 8 records
334 6960 0606 dec r6 ; decrement kilobyte counter
335 6962 16F4 jne next1k ; repeat if not finished
336 ; close the file
337 6964 06A0 mkclse bl @diskio ; write the pab to vdp
337 6966 69B8
338 6968 0103 byte close,3 ; dis/fix output
339 696A 06A0 bl @rstsp ; restore code in scratchpad
339 696C 6AEE
340 ; (destroyed by DSR access)
341 696E 10B6 jmp bufxit
342 ; something went wrong...
343 6970 06C0 mkderr swpb r0
344 6972 C800 mov r0,@errnum ; set disk io error number
344 6974 A038
345 6976 10F6 jmp mkclse ; close file (for what it's worth) and exit
346 ;]
347
348 ;[ compute block address routine
349 ; given buffer number on the stack, gives address of appropriate blk in r0
350 ; and the associated vdp address in r1
351 ; Used by CLEAN, DIRTY, and DIRTY?
352 6978 C034 cba mov *stack+,r0 ; get blk number
353 697A 0A20 sla r0,2 ; convert to offset
354 697C 0201 li r1,blk0 ; address of first blk
354 697E A1B6
355 6980 A001 a r1,r0 ; get address of blk
356 6982 05C0 inct r0 ; point to vdp address pointer
357 6984 C050 mov *r0,r1 ; get vdp address
358 6986 045B rt ; return to caller
359 ;]
360
361 ;[ Free Buffer subroutine. Scans for a free buffer.
362 ; Returns a free blk address in r0.
363 ; r0=0 means there are no free buffers
364 ; a buffer will treated as free if it's dirty flag is not set
365 6988 C0A0 frebuf mov @totblk,r2 ; number of buffers to check
365 698A A1B0
366 698C 0200 li r0,blk0 ; buffer status pointer for 1st buffer
366 698E A1B6
367 6990 C050 nxtfb mov *r0,r1 ; check block assignment
368 6992 1305 jeq bfree ; jump if buffer is free
369 6994 0220 ai r0,4 ; point to next blk
369 6996 0004
370 6998 0602 dec r2 ; finished?
371 699A 16FA jne nxtfb ; check again if not
372 699C 04C0 clr r0 ; there are no free buffers
373 699E 045B bfree rt
374 ;]
375
376 ;[ scan buffers to see if the block in question is already in memory
377 ; expects block number in r0
378 ; returns address of blk in r1, or 0 if the block is not in memory
379 69A0 0201 scnblk li r1,blk0 ; address of first buffer
379 69A2 A1B6
380 69A4 C0A0 mov @totblk,r2 ; number of buffers to check
380 69A6 A1B0
381 69A8 8440 scnnxt c r0,*r1 ; is this the block we're looking for?
382 69AA 1305 jeq fndblk ; jump if yes
383 69AC 0221 ai r1,4 ; check next buffer
383 69AE 0004
384 69B0 0602 dec r2 ; finished?
385 69B2 16FA jne scnnxt ; repeat if not
386 69B4 04C1 clr r1 ; not in memory
387 69B6 045B fndblk rt
388 ;]
389
390 ;[ put the pab into vdp ram with the appropriate opcode in byte 0 of pab
391 ; then call dos...
392 69B8 C83B diskio mov *r11+,@pabopc ; load opcode and file format into ram pab
392 69BA A180
393 69BC C28B mov r11,r10 ; save return address, as BL below will
394 ; destroy it
395 69BE 0201 li r1,pabloc+9 ; vdp address of name length byte
395 69C0 1B81
396 69C2 C801 mov r1,@namptr ; move it to >8356 as per DSR requirements
396 69C4 8356
397 ; write the PAB into VDP ram...
398 69C6 0200 li r0,pabloc ; vdp destination
398 69C8 1B78
399 69CA 0201 li r1,pabopc ; source
399 69CC A180
400 69CE 0202 li r2,30 ; number of bytes to copy to vdp
400 69D0 001E
401 69D2 06A0 bl @_vmbw0 ; write the pab to vdp
401 69D4 7854
402 69D6 0420 blwp @dsrlnk ; call dos
402 69D8 69DE
403 69DA 0008 data 8 ; disk op parameter, level 3 command
404 69DC 045A b *r10
405 ;]
406
407 ;[ dsr link routine - Written by Paolo Bagnaresi
408 69DE A156 dsrlnk data dsrlws ; dsrlnk workspace
409 69E0 69E2 data dlentr ; entry point
410
411 dlentr ; li r0,>37d7
412 ; mov r0,@>8370
413 69E2 0200 li r0,>aa00
413 69E4 AA00
414 69E6 D800 movb r0,@haa ; load haa
414 69E8 A176
415 69EA C17E mov *r14+,r5 ; get pgm type for link
416 69EC C805 mov r5,@sav8a ; save data following blwp @dsrlnk (8 or >a)
416 69EE A148
417 69F0 53E0 szcb @h20,r15 ; reset equal bit
417 69F2 6AEC
418 69F4 C020 mov @>8356,r0 ; get ptr to pab
418 69F6 8356
419 69F8 C240 mov r0,r9 ; save ptr
420 69FA C800 mov r0,@flgptr ; save again pointer to pab+1 for dsrlnk
420 69FC A154
421 ; data 8
422 69FE 0229 ai r9,>fff8 ; adjust to flag
422 6A00 FFF8
423 6A02 06A0 bl @_vsbr ; read device name length
423 6A04 77E4
424 6A06 D0C1 movb r1,r3 ; copy it
425 6A08 0983 srl r3,8 ; make it lo byter
426 6A0A 0704 seto r4 ; init counter
427 6A0C 0202 li r2,namsto ; point to buffer
427 6A0E A178
428 6A10 0580 lnkslp inc r0 ; point to next char of name
429 6A12 0584 inc r4 ; incr char counter
430 6A14 0284 ci r4,>0007 ; see if length more than 7 chars
430 6A16 0007
431 6A18 1561 jgt lnkerr ; yes, error
432 6A1A 80C4 c r4,r3 ; end of name?
433 6A1C 1306 jeq lnksln ; yes
434 6A1E 06A0 bl @_vsbr ; read curr char
434 6A20 77E4
435 6A22 DC81 movb r1,*r2+ ; move into buffer
436 6A24 9801 cb r1,@decmal ; is it a period?
436 6A26 6AEA
437 6A28 16F3 jne lnkslp ; no
438 6A2A C104 lnksln mov r4,r4 ; see if 0 length
439 6A2C 1357 jeq lnkerr ; yes, error
440 6A2E 04E0 clr @>83d0
440 6A30 83D0
441 6A32 C804 mov r4,@>8354 ; save name length for search
441 6A34 8354
442 6A36 C804 mov r4,@savlen ; save it here too
442 6A38 A14E
443 6A3A 0584 inc r4 ; adjust for period
444 6A3C A804 a r4,@>8356 ; point to position after name
444 6A3E 8356
445 6A40 C820 mov @>8356,@savpab ; save pointer to position after name
445 6A42 8356
445 6A44 A150
446 6A46 02E0 srom lwpi >83e0 ; use gplws
446 6A48 83E0
447 6A4A 04C1 clr r1 ; version found of dsr
448 6A4C 020C li r12,>0f00 ; init cru addr
448 6A4E 0F00
449 6A50 C30C norom mov r12,r12 ; anything to turn off?
450 6A52 1301 jeq nooff ; no
451 6A54 1E00 sbz 0 ; yes, turn off
452 6A56 022C nooff ai r12,>0100 ; next rom to turn on
452 6A58 0100
453 6A5A 04E0 clr @>83d0 ; clear in case we are done
453 6A5C 83D0
454 6A5E 028C ci r12,>2000 ; see if done
454 6A60 2000
455 6A62 133A jeq nodsr ; yes, no dsr match
456 6A64 C80C mov r12,@>83d0 ; save addr of next cru
456 6A66 83D0
457 6A68 1D00 sbo 0 ; turn on rom
458 6A6A 0202 li r2,>4000 ; start at beginning of rom
458 6A6C 4000
459 6A6E 9812 cb *r2,@haa ; check for a valid rom
459 6A70 A176
460 6A72 16EE jne norom ; no rom here
461 6A74 A0A0 a @dstype,r2 ; go to first pointer
461 6A76 A160
462 6A78 1003 jmp sgo2
463 6A7A C0A0 sgo mov @>83d2,r2 ; continue where we left off
463 6A7C 83D2
464 6A7E 1D00 sbo 0 ; turn rom back on
465 6A80 C092 sgo2 mov *r2,r2 ; is addr a zero (end of link)
466 6A82 13E6 jeq norom ; yes, no programs to check
467 6A84 C802 mov r2,@>83d2 ; remember where to go next
467 6A86 83D2
468 6A88 05C2 inct r2 ; go to entry point
469 6A8A C272 mov *r2+,r9 ; get entry addr just in case
470 6A8C D160 movb @>8355,r5 ; get length as counter
470 6A8E 8355
471 6A90 1309 jeq namtwo ; if zero, do not check
472 6A92 9C85 cb r5,*r2+ ; see if length matches
473 6A94 16F2 jne sgo ; no, try next
474 6A96 0985 srl r5,8 ; yes, move to lo byte as counter
475 6A98 0206 li r6,namsto ; point to buffer
475 6A9A A178
476 6A9C 9CB6 namone cb *r6+,*r2+ ; compare buffer with rom
477 6A9E 16ED jne sgo ; try next if no match
478 6AA0 0605 dec r5 ; loop til full length checked
479 6AA2 16FC jne namone
480 6AA4 0581 namtwo inc r1 ; next version found
481 6AA6 C801 mov r1,@savver ; save version
481 6AA8 A152
482 6AAA C809 mov r9,@savent ; save entry addr
482 6AAC A14C
483 6AAE C80C mov r12,@savcru ; save cru
483 6AB0 A14A
484 6AB2 0699 bl *r9 ; go run routine
485 6AB4 10E2 jmp sgo ; error return
486 6AB6 1E00 sbz 0 ; turn off rom if good return
487 6AB8 02E0 lwpi dsrlws ; restore workspace
487 6ABA A156
488 6ABC C009 mov r9,r0 ; point to flag in pab
489 6ABE C060 frmdsr mov @sav8a,r1 ; get back data following blwp @dsrlnk
489 6AC0 A148
490 ; (8 or >a)
491 6AC2 0281 ci r1,8 ; was it 8?
491 6AC4 0008
492 6AC6 1303 jeq dsrdt8 ; yes, jump: normal dsrlnk
493 6AC8 D060 movb @>8350,r1 ; no, we have a data >a. get error byte from
493 6ACA 8350
494 ; >8350
495 6ACC 1002 jmp dsrdta ; go and return error byte to the caller
496 6ACE 06A0 dsrdt8 bl @_vsbr ; read flag
496 6AD0 77E4
497 6AD2 09D1 dsrdta srl r1,13 ; just keep error bits
498 6AD4 1604 jne ioerr ; handle error
499 6AD6 0380 rtwp
500 6AD8 02E0 nodsr lwpi dsrlws ; no dsr, restore workspace
500 6ADA A156
501 6ADC 04C1 lnkerr clr r1 ; clear flag for error 0 = bad device name
502 6ADE 06C1 ioerr swpb r1 ; put error in hi byte
503 6AE0 D741 movb r1,*r13 ; store error flags in callers r0
504 6AE2 F3E0 socb @h20,r15 ; set equal bit to indicate error
504 6AE4 6AEC
505 6AE6 0380 rtwp
506
507 6AE8 0008 data8 data >8 ; just to compare. 8 is the data that
508 ; usually follows a blwp @dsrlnk
509 6AEA 2E decmal text '.' ; for finding end of device name
510 6AEB 0000 even
511 6AEC 2000 h20 data >2000
512 ;]
513
514 ;[ restore code to scratch-pad ram
515 ; accessing the disk via the disk DSR destroys some code in scratch pad
516 ; restore the code in scratch pad before returning
517 6AEE 0200 rstsp li r0,toram ; address of 1st source block
517 6AF0 7EB8
518 6AF2 0201 li r1,docol ; destination
518 6AF4 8320
519 6AF6 CC70 rstsp1 mov *r0+,*r1+ ; copy a cell
520 6AF8 0280 ci r0,__dup
520 6AFA 7F06
521 6AFC 1602 jne rstsp3
522 6AFE 0201 li r1,_dup
522 6B00 8382
523 6B02 0280 rstsp3 ci r0,padend ; hit end of first block of code?
523 6B04 7F44
524 6B06 16F7 jne rstsp1 ; loop if not
525 6B08 045B rt
526 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-07-Double.a99'
*
1
2 ; Double Number Words - removed and included in the 32-bit library
3
4 ;[ 2DROP ( d -- )
5 ;_drop2 dect stack ; move back up the stack 4 bytes
6 ; dect stack
7 ;drop2x b @retB0
8 ;]
9
10 ;[ 2DUP ( d -- d d )
11 6B0A C914 _dup2 mov *stack,@-4(stack) ; copy tos
11 6B0C FFFC
12 6B0E 0644 dect stack
13 6B10 C524 mov @4(stack),*stack
13 6B12 0004
14 6B14 0644 dect stack
15 6B16 0460 b @retB0
15 6B18 833A
16 ;]
17
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-08-Parsing.a99'
*
1 ; _____ _ __ __ _
2 ; | __ \ (_) \ \ / / | |
3 ; | |__) |__ _ _ __ ___ _ _ __ __ _ \ \ /\ / /___ _ __ __| |___
4 ; | ___// _` | '__/ __| | '_ \ / _` | \ \/ \/ // _ \| '__/ _` / __|
5 ; | | | (_| | | \__ \ | | | | (_| | \ /\ /| (_) | | | (_| \__ \
6 ; |_| \__,_|_| |___/_|_| |_|\__, | \/ \/ \___/|_| \__,_|___/
7 ; __/ |
8 ; |___/
9 ; Dictionary lookup and associated parsing words
10
11 ;[ WORD ( delimiter address -- address length )
12 ;
13 ; Moves through TIB in VDP memory, discarding leading delimiters,
14 ; looking for a word. A word is identified when a trailing delimiter is
15 ; detected. The identified word is copied from VDP to a buffer in CPU memory.
16 ; Pushes the start address of the word (in CPU memory), and the length of
17 ; the word to the stack. If no word is found (for example if we hit the
18 ; end of the TIB without detecting a word then 0 0 is pushed on the
19 ; stack.
20 6B1A C014 _word mov *stack,r0 ; buffer address
21 6B1C A020 a @in,r0 ; add offset
21 6B1E A042
22 6B20 C0A4 mov @2(stack),r2 ; delimeter
22 6B22 0002
23 6B24 0A82 sla r2,8 ; move to high-byte
24 6B26 0206 li r6,wrdbuf+1 ; address of cpu word buffer
24 6B28 A1D1
25 6B2A C906 mov r6,@2(stack) ; push it to stack
25 6B2C 0002
26 6B2E 04C8 clr r8 ; length counter
27 6B30 C1E0 mov @_span,r7 ; number of chars in buffer
27 6B32 A04C
28 6B34 131F jeq noword ; if 0 then there's no word
29 6B36 8820 c @in,@_span ; hit end of buffer?
29 6B38 A042
29 6B3A A04C
30 6B3C 141B jhe noword ; if yes then exit
31
32 6B3E 06A0 wrd1 bl @wrdgb ; read a character and advance along input
32 6B40 6B86
33 6B42 05A0 inc @in ; advance >IN
33 6B44 A042
34 6B46 9081 cb r1,r2 ; was the character a delimiter?
35 6B48 13FA jeq wrd1 ; if yes then get another character
36 6B4A 8820 c @in,@_span ; hit end of buffer?
36 6B4C A042
36 6B4E A04C
37 6B50 150F jgt wrdfin ; if yes then quit
38 6B52 DD81 wrd2 movb r1,*r6+ ; move character to word buffer
39 6B54 0588 inc r8 ; increment length
40 6B56 8808 c r8,@tibsiz ; have we fully populated the word buffer?
40 6B58 A04A
41 6B5A 130A jeq wrdfin ; if yes then exit
42 6B5C 06A0 bl @wrdgb ; read a character and advance along input
42 6B5E 6B86
43 6B60 05A0 inc @in ; advance >in
43 6B62 A042
44 6B64 8820 c @in,@_span ; hit end of buffer?
44 6B66 A042
44 6B68 A04C
45 6B6A 1502 jgt wrdfin ; if yes then quit
46 6B6C 9081 cb r1,r2 ; was the character a delimeter?
47 6B6E 16F1 jne wrd2 ; if not then get another character
48 6B70 C508 wrdfin mov r8,*stack ; push length to stack
49 6B72 1004 jmp wrdxit1 ; exit
50 6B74 04D4 noword clr *stack ; no word found, push 0 length
51 6B76 04E4 clr @2(stack) ; zero address
51 6B78 0002
52 6B7A 04C8 clr r8
53 6B7C 06C8 wrdxit1 swpb r8 ; populate length byte (for packed string)
54 6B7E D808 movb r8,@wrdbuf
54 6B80 A1D0
55 6B82 0460 wrdxit2 b @retB0
55 6B84 833A
56
57 6B86 C3E0 wrdgb mov @source,r15 ; check source
57 6B88 A058
58 6B8A 1302 jeq vread ; if 0 then read from vdp
59 ; special case: if EVALUATE is active then the evaluation string will be in
60 ; CPU RAM
61 6B8C D070 movb *r0+,r1 ; otherwise read from cpu and advance buffer
62 6B8E 045B rt ; return to caller
63 6B90 C38B vread mov r11,r14 ; save return address
64 6B92 06A0 vread1 bl @_vsbr ; read from vdp
64 6B94 77E4
65 6B96 0580 vread2 inc r0 ; advance input buffer address
66 6B98 045E b *r14 ; return to caller
67 ;]
68
69 ;[ code for processing \ type comments
70 ; assembly equivalent of : \ >IN @ 64 + -64 AND >IN ! ; IMMEDIATE
71 6B9A C020 _trcom mov @blknum,r0 ; loading a block?
71 6B9C A1B2
72 6B9E 1309 jeq trcom1 ; jump if not
73 6BA0 C020 mov @in,r0
73 6BA2 A042
74 6BA4 0220 ai r0,64
74 6BA6 0040
75 6BA8 0240 andi r0,-64
75 6BAA FFC0
76 6BAC C800 mov r0,@in
76 6BAE A042
77 6BB0 10E8 jmp wrdxit2 ; exit (jump is smaller than a branch!)
78 6BB2 C820 trcom1 mov @tibsiz,@in ; set >IN to the end of the line
78 6BB4 A04A
78 6BB6 A042
79 6BB8 10E4 comxit jmp wrdxit2 ; exit (jump is smaller than a branch!)
80 ;]
81
82 ;[ NUMBER ( address length -- (numberMSW) numberLSW error )
83 ; Attempts to convert the string at cpu address address into a number.
84 ; If fully successful, the number is placed on the stack and flag will be 0.
85 ; If it fails (for example contains an illegal character) then a partial number
86 ; will be placed on the stack (the value computed up until the failure) and
87 ; flag will be >0.
88 ; Thus, if flag>0 the string failed to parse fully as a number.
89 ; A minus sign is permitted for negative numbers.
90 ; This routine uses BASE to parse numbers in the current BASE.
91 ; Eg. If BASE=16 then digits 0-9 and A-F are considered legal and will be
92 ; parsed properly.
93 ; A facility also exists called 'quick hex' that allows a number to be entered
94 ; in base 16, by placing a $ symbol at the beginning of the string. This avoids
95 ; the need to change BASE to enter a number. E.g. instead of HEX FEED DECIMAL
96 ; you can simply do $FEED. The number will be parsed as a HEX number without the
97 ; need to change BASE.
98 ; The same facility also exists for binary numbers: use a % symbol.
99 ; E.g. %1001 = 9 decimal
100 ; The numbers returned are (by default) singles (16 bits). NUMBER can can also
101 ; return a double (32-bit (2 stack cells)) value by including a period in the
102 ; number string. E.g. 100. 1.00 10.0 .100 will all return 100 decimal as a
103 ; double.
104 ; The various facilities can be mixed. For example, -$.F means -15 as a double.
105 6BBA C074 _numbr mov *stack+,r1 ; pop length
106 6BBC C014 mov *stack,r0 ; get address from stack
107 ; parse the number string...
108 6BBE 04C6 parsnm clr r6 ; initialise MSW
109 6BC0 04C8 clr r8 ; initialise LSW
110 6BC2 04CD clr r13 ; clear negative flag
111 6BC4 04CC clr r12 ; clear 'double required' flag
112 6BC6 0720 seto @dpl ; assume single precision
112 6BC8 A054
113 ; begin ugly hack - check the end of the number for a period character
114 ; if found, set double indicator (R12) to on and reduce length of string
115 ; by 1. Added for TF V1.1 double precision library support
116 6BCA C3C0 mov r0,r15 ; copy string address
117 6BCC A001 a r1,0 ; add length
118 6BCE 0600 dec r0 ; point to last character in the buffer
119 6BD0 D0B0 movb *r0+,r2 ; get character from buffer
120 6BD2 0982 srl r2,8 ; move it to low byte
121 6BD4 0282 ci r2,'.' ; is it a period character?
121 6BD6 002E
122 6BD8 1604 jne xugly ; if not then skip
123 6BDA 070C seto r12 ; otherwise set the double flag to on
124 6BDC 0601 dec r1 ; and reduce the length for the string so
125 ; that the period will not be seen by the
126 ; number parser
127 6BDE 0720 seto @dpl ; double integer
127 6BE0 A054
128 ; end ugly hack
129 6BE2 C00F xugly mov r15,r0
130 6BE4 C3A0 mov @base,r14 ; get base
130 6BE6 A05C
131 6BE8 060E dec r14 ; base-1=highest legal digital for base
132 6BEA D0B0 num0 movb *r0+,r2 ; get character from buffer
133 6BEC 0982 srl r2,8 ; move it to low byte
134 6BEE 0282 num4 ci r2,'%' ; is it a % sign (binary)
134 6BF0 0025
135 6BF2 1603 jne num5
136 6BF4 020E li r14,1 ; set binary base
136 6BF6 0001
137 6BF8 1017 jmp num3 ; do next character
138 6BFA 0282 num5 ci r2,'.' ; is it a dot?
138 6BFC 002E
139 6BFE 160A jne num1 ; skip if not
140 ; double detected - set r12 as flag, and calculate value for DPL
141 6C00 070C seto r12 ; else double is required - set flag
142 6C02 C3E4 mov @2(stack),r15 ; get string length
142 6C04 0002
143 6C06 C1CF mov r15,r7 ;
144 6C08 61C1 s r1,r7 ; subtract current position from length
145 6C0A 63C7 s r7,r15 ; get length to the right of the dec. point
146 6C0C 060F dec r15 ; correcty length due to decimal point
147 6C0E C80F mov r15,@dpl ; store in DPL
147 6C10 A054
148 6C12 100A jmp num3 ; do next character
149 6C14 0282 num1 ci r2,'$' ; is it a dollar sign?
149 6C16 0024
150 6C18 1603 jne num2 ; skip if not
151 6C1A 020E li r14,15 ; force base temporarily to 16-1 for hex
151 6C1C 000F
152 6C1E 1004 jmp num3 ; check next character
153 6C20 0282 num2 ci r2,'-' ; is it a negative sign?
153 6C22 002D
154 6C24 1603 jne numlz ; skip if not
155 6C26 070D seto r13 ; else set negative flag
156 6C28 0601 num3 dec r1 ; decrement counter
157 6C2A 10DF jmp num0 ; get next character
158 6C2C 0282 numlz ci r2,'0' ; check if ascii code < "0"
158 6C2E 0030
159 6C30 1A09 jl ohshit ; error if yes
160 6C32 0282 ci r2,'Z' ; check if ascii code > "Z"
160 6C34 005A
161 6C36 1B06 jh ohshit ; error if yes
162 6C38 0282 ci r2,'9' ; check if ascii code <= "9"
162 6C3A 0039
163 6C3C 1209 jle numisd ; its a numerical digit between 0-9
164 6C3E 0282 ci r2,'A' ; check if ascii code >= "A"
164 6C40 0041
165 6C42 1403 jhe numisl ; its a letter between A-Z
166 6C44 0200 ohshit li r0,2 ; else illegal digit was detected
166 6C46 0002
167 ; indicate error
168 6C48 1018 jmp nexit
169 6C4A 0222 numisl ai r2,-55 ; convert from letter to number
169 6C4C FFC9
170 ; ("A" (65) becomes 10)
171 6C4E 1002 jmp numgo ; start the conversion
172 6C50 0222 numisd ai r2,-48 ; convert from ascii to decimal
172 6C52 FFD0
173 ; ("0" (48) becomes 0)
174 ; parse the string into a 32 bit number...
175 6C54 8382 numgo c r2,r14 ; compare to base
176 6C56 1BF6 jh ohshit ; if digit outside current base's legal
177 ; range then exit
178 6C58 A202 a r2,r8 ; add digit to LSW
179 6C5A 0601 dec r1 ; finished?
180 6C5C 1309 jeq numend ; jump if yes
181 6C5E C08E mov r14,r2 ; base-1 to r2
182 6C60 0582 inc r2 ; correct to base
183 6C62 C1C8 mov r8,r7 ; get our lsw in r7
184 6C64 39C2 mpy r2,r7 ; multiply it by current base
185 6C66 C246 mov r6,r9 ; get our MSW
186 6C68 3A42 mpy r2,r9 ; multiply it by current base
187 6C6A C18A mov r10,r6 ; move it back
188 6C6C A187 a r7,r6 ; add MSW from MPY to *our* MSW
189 6C6E 10BD jmp num0 ; do next digit
190 6C70 04C0 numend clr r0 ; finished with no errors, clear error flag
191 6C72 C34D mov r13,r13 ; and check negative flag
192 6C74 1302 jeq nexit ; jump if not set (positive number)
193 6C76 0546 inv r6 ; else two's complement the 32 bit word
194 6C78 0508 neg r8
195 6C7A C508 nexit mov r8,*stack ; push least sig word
196 6C7C 0644 dect stack ; advance stack
197 6C7E C80C mov r12,@isdbl ; was a double returned?
197 6C80 A052
198 6C82 1302 jeq pusher ; if not, skip
199 6C84 C506 mov r6,*stack ; push most sig word
200 6C86 0644 dect stack ; advance stack
201 6C88 C500 pusher mov r0,*stack ; push error flag
202 6C8A 020C li r12,_next ; restore r12
202 6C8C 8326
203 6C8E 1094 jmp comxit ; exit
204 ; (a jump is 2 bytes shorter than a branch)
205 ;]
206
207 6C90 2000 _space data >2000
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-09-Compilation.a99'
*
1 ; _____ _ _ _ __ __ _
2 ; / ____| (_) (_) \ \ / / | |
3 ; | | ___ _ __ ___ _ __ _| |_ _ __ __ _ \ \ /\ / /___ _ __ __| |___
4 ; | | / _ \| '_ ` _ \| '_ \| | | | '_ \ / _` | \ \/ \/ // _ \| '__/ _` / __|
5 ; | |____| (_) | | | | | | |_) | | | | | | | (_| | \ /\ /| (_) | | | (_| \__ \
6 ; \_____|\___/|_| |_| |_| .__/|_|_|_|_| |_|\__, | \/ \/ \___/|_| \__,_|___/
7 ; | | __/ |
8 ; |_| |___/
9 ; Compilation words...
10
11 ;[ HEADER ( address length -- )
12 ; creates a dictionary entry starting at HERE, and links it to the previous
13 ; dictionary entry.
14 6C92 C074 _headr mov *stack+,r1 ; length in r1
15 6C94 0241 andi r1,15 ; restrict length to 15
15 6C96 000F
16 6C98 C181 hdr0 mov r1,r6 ; copy length of word to use as a counter
17 ; mov @blknum,r0 ; get 'are we loading?' flag
18 6C9A C020 mov @lstblk,r0 ; get 'are we loading?' flag
18 6C9C A1B4
19 6C9E 1303 jeq hdr1 ; if not then skip
20 6CA0 0600 dec r0 ; decrement by 1 to give room for 0 to 1023
21 6CA2 0A40 sla r0,4 ; shift into position
22 6CA4 E040 soc r0,r1 ; OR into length word
23 6CA6 C034 hdr1 mov *stack+,r0 ; pop address of word to r0
24 6CA8 C0A0 mov @here,r2 ; here to r2
24 6CAA A046
25 6CAC C4A0 mov @latest,*r2 ; create link to previous dictionary entry
25 6CAE A044
26 6CB0 C802 mov r2,@latest ; update latest to point to this entry
26 6CB2 A044
27 6CB4 05C2 inct r2 ; move forward in memory
28 6CB6 CC81 mov r1,*r2+ ; append length of word to dictionary entry
29 6CB8 DCB0 crtlp movb *r0+,*r2+ ; get a character
30 6CBA 0606 dec r6 ; finished copying name?
31 6CBC 16FD jne crtlp ; repeat if not
32 6CBE 0582 inc r2 ; we're gonna force r2 to an even address...
33 6CC0 0242 andi r2,>fffe ; force to even address
33 6CC2 FFFE
34 6CC4 C802 mov r2,@here ; update here
34 6CC6 A046
35 6CC8 C802 mov r2,@patch ; update most recent CFA locaation
35 6CCA A06A
36 6CCC C002 mov r2,r0 ; copy to r0 for memory pointer adjust rtn.
37 6CCE 1005 jmp mpadj ; update memory free pointers and exit
38 ;]
39
40 ;[ , (COMMA) ( value -- )
41 ; appends 16 bit word on TOS to the user memory addressed by HERE and updates
42 ; HERE to point to next word
43 6CD0 C020 _comma mov @here,r0 ; get next free address in r0
43 6CD2 A046
44 6CD4 CC34 mov *stack+,*r0+ ; pop value to HERE
45 6CD6 C800 mov r0,@here ; update HERE
45 6CD8 A046
46 6CDA 0280 mpadj ci r0,>a000 ; are we in high memory?
46 6CDC A000
47 6CDE 1A03 jl lomadj ; no, take the jump
48 6CE0 C800 mov r0,@ffaihm ; we must be writing in low ram. update low
48 6CE2 A01C
49 ; mem pointer
50 6CE4 1002 jmp commax
51 6CE6 C800 lomadj mov r0,@ffailm ; update high memory pointer
51 6CE8 A01A
52 6CEA 0460 commax b @retB0
52 6CEC 833A
53 ;]
54
55 ;[ C, (COMMA) ( value -- )
56 ; appends an 8 bit value, from the least significant byte of TOS to HERE.
57 ; Here is incremented by ONE BYTE, not one WORD.
58 ; For safety, use ALIGN to align HERE to a word boundary afterwards.
59 6CEE C020 _comab mov @here,r0 ; get next free address in r0
59 6CF0 A046
60 6CF2 C074 mov *stack+,r1 ; get stack value in r1
61 6CF4 06C1 swpb r1 ; get TOS in most significant byte
62 6CF6 DC01 movb r1,*r0+ ; mov data in TOS to HERE and increment by
63 ; one byte
64 6CF8 C800 mov r0,@here ; update HERE
64 6CFA A046
65 6CFC 10EE jmp mpadj ; update memory pointers
66 ;]
67
68 ;[ ALIGN ( -- )
69 ; Aligns HERE to an even word boundary by rounding up if required
70 ; Call it after using C!
71 6CFE C020 _align mov @here,r0 ; get HERE
71 6D00 A046
72 6D02 0580 inc r0 ; add 1
73 6D04 0240 andi r0,>fffe ; round up if required
73 6D06 FFFE
74 6D08 C800 mov r0,@here ; store it
74 6D0A A046
75 6D0C 10E6 jmp mpadj ; update memory pointers
76 ;]
77
78 ;[ HIDDEN ( dictionary_address -- )
79 ; toggles the hidden attribute on the dictionary entry
80 ; normally you would hide a word after defining it with: LATEST @ HIDDEN
81 6D0E C034 _hide mov *stack+,r0 ; pop address of dictionary entry to r0
82 6D10 05C0 inct r0 ; point to length entry
83 6D12 C050 mov *r0,r1 ; get the length entry
84 6D14 2860 xor @_bit1,r1 ; toggle hidden bit (weight >4000)
84 6D16 78B6
85 6D18 C401 mov r1,*r0 ; store it
86 6D1A 10E7 jmp commax
87 ;]
88
89 ;[ IMMEDIATE ( -- )
90 ; toggles the immediate bit in the dictionary entry pointed to by LATEST.
91 6D1C C020 _imm mov @latest,r0 ; get address of latest dictionary entry
91 6D1E A044
92 6D20 05C0 inct r0 ; point to length entry
93 6D22 C050 mov *r0,r1 ; get the length entry
94 6D24 2860 xor @_bit0,r1 ; toggle immediate bit (weight >8000)
94 6D26 78B4
95 6D28 C401 mov r1,*r0 ; store it
96 6D2A 10DF jmp commax
97 ;]
98
99 ;[ ALLOT ( n -- )
100 ; reserves n BYTES of memory, staring from HERE
101 6D2C A834 _allot a *stack+,@here ; pop and add n to HERE
101 6D2E A046
102 6D30 C020 mov @here,r0 ; get HERE in r0 for mpadj routine
102 6D32 A046
103 6D34 10D2 jmp mpadj ; adjust memory pointers
104 ;]
105
106 ;[ COMPILE ( -- )
107 ; Used in colon definitiona. Compiles the next word into the current definition
108 ; the word is not executed. E.g. COMPILE DROP compiles DROP to HERE. DROP is not
109 ; actually executed
110 ; important note: see COMPILE in 0-10-Compilation.a99
111 6D36 C020 _compil mov @here,r0 ; get HERE
111 6D38 A046
112 6D3A CC01 mov r1,*r0+ ; compile next word to HERE & increase HERE
113 6D3C C800 mov r0,@here ; save HERE
113 6D3E A046
114 6D40 10CC jmp mpadj ; adjust memory pointers
115 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-10-Strings.a99'
*
1 ; _____ _ _ __ __ _
2 ; / ____| | (_) \ \ / / | |
3 ; | (___ | |_ _ __ _ _ __ __ _ \ \ /\ / /___ _ __ __| |___
4 ; \___ \| __| '__| | '_ \ / _` | \ \/ \/ // _ \| '__/ _` / __|
5 ; ____) | |_| | | | | | | (_| | \ /\ /| (_) | | | (_| \__ \
6 ; |_____/ \__|_| |_|_| |_|\__, | \/ \/ \___/|_| \__,_|___/
7 ; string related words __/ |
8 ; |___/
9
10 ;[ RND ( limit -- n)
11 ; pushes a pseudo random number between 0 and limit-1 (rnd MOD limit)
12 ; For the full range (0-65535) use a limit of 0
13 6D42 C060 _rnd mov @seed,r1
13 6D44 A076
14 6D46 0200 li r0,>6fe5 ; multiplier
14 6D48 6FE5
15 6D4A 3840 mpy r0,r1 ; mpultiply r1 by r0
16 6D4C 0222 ai r2,>7ab9 ; add 7ab9 to r2
16 6D4E 7AB9
17 6D50 0B52 src r2,5 ; rotate r2 5 bits right
18 6D52 C802 mov r2,@seed
18 6D54 A076
19 6D56 04C1 clr r1 ; msw of dividend
20 6D58 3C54 div *stack,r1 ; divide R1 by # on stack
21 6D5A C502 mov r2,*stack ; copy remainder, R2, to stack
22 6D5C 0460 rndx b @retb0
22 6D5E 833A
23 ;]
24
25 ;[ COUNT ( addr1 -- addr2 len )
26 ; addr2 is addr1+1 and len is the length of the counted string at addr1.
27 ; The byte at addr1 contains the byte count len. Range of len is {0.255}
28 6D60 C014 _count mov *stack,r0 ; get addr1
29 6D62 D1D0 movb *r0,r7 ; get length byte from addr1
30 6D64 0987 srl r7,8 ; move to low byte
31 6D66 0594 inc *stack ; increment addr1 to make addr2
32 6D68 0644 PAE dect stack ; make space on stack
33 6D6A C507 mov r7,*stack ; push length
34 6D6C 10F7 jmp rndx
35 ;]
36
37 ;[ -TRAILING ( addr len -- addr len )
38 ; modifies len such that trailing spaces are excluded from the string
39 6D6E C514 _trail mov *stack,*stack ; check length
40 6D70 1308 jeq trlout ; if 0 then exit
41 6D72 1107 jlt trlout ; if negative then exit
42 6D74 C024 mov @2(stack),r0 ; address
42 6D76 0002
43 6D78 A014 a *stack,r0 ; move to end of string+1
44 6D7A 0600 dec r0 ; correct to point to last character
45 6D7C 9810 trail2 cb *r0,@_space ; compare to a space
45 6D7E 6C90
46 6D80 1301 jeq trail1 ; if a space, reduce length
47 6D82 10EC trlout jmp rndx ; else exit
48 6D84 0614 trail1 dec *stack ; reduce length
49 6D86 13EA jeq rndx ; if we get to 0 then exit
50 6D88 0600 dec r0 ; else check next address
51 6D8A 10F8 jmp trail2
52 ;]
53
54 ;[ S" Compile time:( -- ) Immediate:( -- address length )
55 ; When Compiling:
56 ; compiles: (S")
57 ; e.g S" HELLO" compiles (S") 5 H E L L O
58 ; At the end of string compilation, HERE is aligned to an even address.
59 ; At run time, (S") (see below) pushes the address of the beginning of
60 ; the string and the length to the stack.
61 ;
62 ; When Interpreting:
63 ; Compiles the string to the address PAD, as above, and pushes the address and
64 ; length to the stack.
65 6D8C C020 _strin mov @_state,r0 ; check state
65 6D8E A048
66 6D90 160B jne _stri1 ; jump if compiling
67
68 ; not compiling, move string to PAD and adjust address
69 6D92 C034 mov *stack+,r0 ; get pad address
70 6D94 C180 mov r0,r6 ; copy it
71 6D96 C094 mov *stack,r2 ; get length
72 6D98 C064 mov @2(stack),r1 ; get source address
72 6D9A 0002
73
74 6D9C DC31 strc1 movb *r1+,*r0+ ; copy to pad
75 6D9E 0602 dec r2
76 6DA0 16FD jne strc1
77 6DA2 C906 mov r6,@2(stack) ; put PAD address in place of original
77 6DA4 0002
78 ; address
79 6DA6 10DA jmp rndx
80
81 ; compiling. compile (S")
82 6DA8 C034 _stri1 mov *stack+,r0 ; discard pad address on stack
83 6DAA C020 mov @here,r0 ; compilation address
83 6DAC A046
84 6DAE 0201 li r1,str ; CFA of (S")
84 6DB0 791E
85 6DB2 CC01 mov r1,*r0+ ' compile (S")
86 6DB4 C0B4 mov *stack+,r2 ; get length
87 6DB6 06C2 swpb r2 ; move to high byte
88 6DB8 DC02 movb r2,*r0+ ; compile length byte
89
90 6DBA 06C2 swpb r2 ; restore length
91 6DBC C074 mov *stack+,r1 ; address of string in cpu memory
92 6DBE DC31 _stri2 movb *r1+,*r0+ ; copy string to definition
93 6DC0 0602 dec r2 ; finished?
94 6DC2 16FD jne _stri2
95 6DC4 0580 inc r0 ; round up HERE
96 6DC6 0240 andi r0,>fffe ; mask off LSB
96 6DC8 FFFE
97 6DCA C800 mov r0,@here ; store it
97 6DCC A046
98 6DCE 0460 b @mpadj ; adjust memory pointers and exit via mpadj
98 6DD0 6CDA
99 ;]
100
101 ;[ (S") ( -- cpu_addr len )
102 ; pushes the address and length of the string (compiled by S") onto the stack
103 ; On entry, PC is actually pointing at the length byte. The address of the
104 ; string is actually the address of the length byte+1. The length is just the
105 ; value of the length byte. PC is adjusted to resume execution at the first even
106 ; cell following the string.
107 6DD2 D033 _str movb *pc+,r0 ; get length
108 6DD4 0644 dect stack ; make space on stack
109 6DD6 C503 mov pc,*stack ; move address of string to stack
110 6DD8 0644 dect stack ; make space on stack
111 6DDA 0980 srl r0,8 ; place length in low byte
112 6DDC C500 mov r0,*stack ; place length on stack
113 6DDE A0C0 a r0,pc ; advance program counter
114 6DE0 0223 ai pc,1 ; round up PC...
114 6DE2 0001
115 6DE4 0243 andi pc,>fffe ; ...to an even value
115 6DE6 FFFE
116 6DE8 0460 b @retB0
116 6DEA 833A
117 ;]
118
119 ;[ NUMBER TO STRING ( num -- addr len )
120 ; Takes a number off the stack and converts it to a signed string equivalent,
121 ; with respect to the current number base. Number base may be between
122 ; 2 and 36. The routine checks location DOSIGN, and if 0, the
123 ; number is treated as signed, else its unsigned. The routine also checks
124 ; location LZI, and, if zero, leading zero's will be supressed.
125 ; This is quite a bitch of a routine. Since any number base (between 2 and 36)
126 ; can be employed this routine is rather complex. The routine must first
127 ; determine the appropriate powers of the number base so we can divide the
128 ; target number later. Obviously this is expensive, so the routine remembers
129 ; what the active number base was the last time it was called, and ONLY
130 ; re-computes the exponents if the base has changed since the last time it was
131 ; called.
132 ; This first part computes the column values.
133 ; So, if the base is 10, you end up with 1,10,100,1000,10000
134 6DEC C385 _nts mov rstack,r14 ; save rstack 'cos we're using it
135 6DEE C254 mov *stack,r9 ; get number off stack
136 6DF0 0207 li r7,2 ; exponent counter (base^0 and base^1 are
136 6DF2 0002
137 ; easy to compute ;-)
138 ; used as a word offset into workbuffer so
139 ; counts in multiples of 2.
140 6DF4 8820 c @base,@lbase ; check if base has chaged since the last
140 6DF6 A05C
140 6DF8 A05E
141 ; time we were called
142 6DFA 1314 jeq dodiv ; base hasn't changed, no need to compute
143 ; powers of the base.
144 6DFC C820 mov @base,@lbase ; base has changed, store it in 'last base'
144 6DFE A05C
144 6E00 A05E
145 6E02 0200 li r0,1 ; base^0 is always 1 - easy ;-)
145 6E04 0001
146 6E06 0201 li r1,wrkbuf ; place to store the powers of our base
146 6E08 A222
147 ; determine base^x until result > 65535
148 6E0A CC40 mov r0,*r1+ ; store base^0 and move forward in buffer
149 6E0C C460 mov @base,*r1 ; base^1 is always base ;-) store it
149 6E0E A05C
150 6E10 C171 pwr mov *r1+,r5 ; get previous exponent
151 6E12 3960 mpy @base,r5 ; multiply it by base - lower 16 bit result
151 6E14 A05C
152 ; in r6
153 6E16 C145 mov r5,r5 ; see if the result overflowed into upper
154 ; 16 bits
155 6E18 1603 jne pwrout ; there was an overflow, exit loop
156 6E1A C446 mov r6,*r1 ; otherwise store result
157 6E1C 05C7 inct r7 ; and increment exponent counter
158 6E1E 10F8 jmp pwr ; and repeat
159 ; Ok we have computed the 'column values' (powers) for our base. Now we
160 ; sucessively divide the number down until nothing is left, building
161 ; the string equivalent as we compute each digit. Just to make life
162 ; harder for ourselves, we will optionally allow leading zero's to be
163 ; supressed. If the word at LZI<>0 then leading zero's are suppressed.
164 6E20 C807 pwrout mov r7,@expcnt ; save exponent count for next time routine
164 6E22 A060
165 ; is run
166 6E24 C1E0 dodiv mov @expcnt,r7 ; entry point when exponents arent computed.
166 6E26 A060
167 ; restore exponent count
168 6E28 0200 li r0,strbuf ; address of string buffer where we build
168 6E2A A242
169 ; the string
170 6E2C 04C1 clr r1 ; buffer length counter
171 6E2E C220 mov @dosign,r8 ; check if producing an unsigned number
171 6E30 A064
172 6E32 1609 jne ninn ; skip if we are
173 6E34 C209 mov r9,r8 ; else, check if number is negative and if
174 ; so, add "-" character
175 6E36 0248 andi r8,>8000 ; is it negative
175 6E38 8000
176 6E3A 1305 jeq ninn ; its not negative, jump
177 6E3C 0208 li r8,'-'*256 ; the number is negative, add a minus sign
177 6E3E 2D00
178 ; to the string buffer
179 6E40 DC08 movb r8,*r0+ ; place it in the buffer
180 6E42 0581 inc r1 ; increment length counter
181 6E44 0509 neg r9 ; change the number to positive
182 6E46 04C8 ninn clr r8 ; div instruction uses 32 bit dividend, our
183 ; 16 bit argument is in r9
184 6E48 C2A0 mov @lzi,r10 ; leading zero indicator 0=suppress
184 6E4A A062
185 6E4C 3E27 nxtdig div @wrkbuf(r7),r8 ; divide our number by exponent value.
185 6E4E A222
186 ; result=r8, remainder=r9
187 6E50 C208 mov r8,r8 ; was the result 0?
188 6E52 1312 jeq testlz ; if yes then check if ignoring leading
189 ; zeros
190 6E54 070A seto r10 ; not zero, so reset leading zero indicator
191 6E56 DC28 dodig movb @tlut(r8),*r0+ ; lookup digit value, move it to string
191 6E58 6E7E
192 ; buffer and advance buffer address
193 6E5A 04C8 clr r8 ; clear result for next interation
194 6E5C 0581 inc r1 ; increment length counter
195 6E5E 0647 iglz dect r7 ; done all our columns/exponents?
196 6E60 16F5 jne nxtdig ; loop if not
197 6E62 DC29 movb @tlut(r9),*r0+ ; lookup digit value, move it to string
197 6E64 6E7E
198 ; buffer and advance buffer address
199 ; we've done our division, push address & length to the stack and exit
200 6E66 0200 li r0,strbuf ; address of string buffer
200 6E68 A242
201 6E6A C500 mov r0,*stack ; move address to stack
202 6E6C 0644 dect stack ; new stack entry
203 6E6E 0581 inc r1 ; adjust length for remainder
204 6E70 C501 mov r1,*stack ; move length to stack
205 6E72 C14E mov r14,rstack ; restore return stack pointer
206 6E74 0460 b @retB0
206 6E76 833A
207 ; we're looking for leading zero's and ignoring them
208 6E78 C28A testlz mov r10,r10 ; are we ignoring leading zero's?
209 6E7A 13F1 jeq iglz ; 0=ignore leading digit
210 6E7C 10EC jmp dodig ; else do digit normally
211 ; character lookup table for printing numbers between bases 2 to 36
212 6E7E 3031 tlut text '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
212 6E80 3233
212 6E82 3435
212 6E84 3637
212 6E86 3839
212 6E88 4142
212 6E8A 4344
212 6E8C 4546
212 6E8E 4748
212 6E90 494A
212 6E92 4B4C
212 6E94 4D4E
212 6E96 4F50
212 6E98 5152
212 6E9A 5354
212 6E9C 5556
212 6E9E 5758
212 6EA0 595A
213 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-11-Editor.a99'
*
1 ; ______ _ _ _ __ __ _
2 ; | ____| | (_) | \ \ / / | |
3 ; | |__ __| |_| |_ ___ _ __ \ \ /\ / /___ _ __ __| |___
4 ; | __| / _` | | __|/ _ \| '__| \ \/ \/ // _ \| '__/ _` / __|
5 ; | |____| (_| | | |_| (_) | | \ /\ /| (_) | | | (_| \__ \
6 ; |______|\__,_|_|\__|\___/|_| \/ \/ \___/|_| \__,_|___/
7 ; block editor
8
9 0000 FF83 keyCC equ -125 ; key code for ctrl c (copy line)
10 0000 FF96 keyCV equ -106 ; key code for ctrl v (paste line)
11 0000 FF89 keyCI equ -119 ; key code for ctrl i (insert line)
12 0000 FF84 keyCD equ -124 ; key code for ctrl d (delete line)
13 0000 FF8F keyCO equ -113 ; key code for ctrl o (previous block)
14 0000 FF90 keyCP equ -112 ; key code for ctrl p (next block)
15 0000 000F keyF9 equ 15 ; key code for function 9 (back)
16
17 0000 0001 keyF7 equ 1 ; key code for function 7 (tab)
18 0000 0002 keyF4 equ 2 ; key code for function 4 (escape)
19 0000 0007 keyF3 equ 7 ; key code for function 3 (erase line)
20 0000 0004 keyF2 equ 4 ; key code for function 2 (insert/overwrite)
21 0000 0003 keyF1 equ 3 ; key code for function 1 (del)
22 0000 000B keyFE equ 11 ; cursor up keycode
23 0000 0008 keyFS equ 8 ; cursor left keycode
24 0000 0009 keyFD equ 9 ; cursor right keycode
25 0000 000A keyFX equ 10 ; cursor down keycode
26 0000 0005 keyFeq equ 5 ; keycode for function = (quit)
27 0000 000D keyRET equ 13 ; keycode for ENTER key
28
29 0000 A028 savkey equ scrx ; borrow scrX memory location for saving
30 ; keypresses
31
32 6EA2 04E0 _edit clr @csrflg ; clear shared cursor flash flag
32 6EA4 A080
33 ; (shared with forcnt)
34 6EA6 04E0 clr @temp2 ; next block to load
34 6EA8 A072
35 6EAA C014 mov *stack,r0 ; get address from BLOCK
36 6EAC C080 mov r0,r2 ; copy it
37 6EAE 1603 jne _edit1 ; if not zero then continue
38
39 6EB0 05C4 inct stack ; else BLOCK failed to load block.
40 6EB2 0460 b @retB0 ; Remove vdp address from stack and exit
40 6EB4 833A
41
42 ; determine if block is dirty or clean:
43 ; display * next to block number if dirty otherwise display a space
44 6EB6 1503 _edit1 jgt _edit2 ; jump if dirty bit not set
45 6EB8 0201 li r1,'*'*256 ; block is dirty: load asterisk character
45 6EBA 2A00
46 6EBC 1002 jmp _edit3
47 6EBE 0201 _edit2 li r1,>2000 ; block is clean: load space character
47 6EC0 2000
48 ; display character next to block number
49 6EC2 0200 _edit3 li r0,10 ; load screen address
49 6EC4 000A
50 6EC6 06A0 bl @_vsbw0 ; write it to screen
50 6EC8 782C
51
52 6ECA 0242 andi r2,>7fff ; remove dirty bit if set
52 6ECC 7FFF
53 6ECE C502 mov r2,*stack ; write it back, we'll use it further on...
54 6ED0 06A0 bl @csrdef ; define cursor udg
54 6ED2 75F2
55 6ED4 04E0 clr @epage ; set page to first page
55 6ED6 A07A
56 6ED8 04E0 clr @temp ; initialise insert/overwrite mode
56 6EDA A070
57 6EDC 06A0 bl @disblk ; display block number
57 6EDE 763A
58 6EE0 06A0 bl @draws ; draw static parts of the display
58 6EE2 7408
59 6EE4 06A0 bl @drawd ; draw dynamic parts of the display
59 6EE6 73B6
60 6EE8 06A0 bl @insovr ; display mode
60 6EEA 7340
61 6EEC 04E0 clr @csrx ; used for cursor x
61 6EEE A07C
62 6EF0 04E0 clr @csry ; used for cursor y
62 6EF2 A07E
63 6EF4 04E0 clr @cursrd ; reset cursor delay
63 6EF6 A024
64
65 6EF8 06A0 bl @delay ; small delay to give the user time to
65 6EFA 75EA
66 6EFC 7530 data 30000 ; release the enter key!
67
68 ; editor main loop
69 ;[ keyboard scanning and auto-repeat
70 6EFE 06A0 edml2 bl @scnkey ; get key in r7
70 6F00 75BE
71 6F02 C807 edml4 mov r7,@savkey ; save the keypress
71 6F04 A028
72 6F06 0287 ci r7,>ffff ; nothing pressed?
72 6F08 FFFF
73 6F0A 1313 jeq docfl ; if nothing pressed then do cursor flash
74 6F0C 020D li r13,edml3 ; set something pressed - set return point
74 6F0E 6F12
75 ; for post keypress processing
76 6F10 101E jmp chkent ; process the key press
77 6F12 0200 edml3 li r0,475 ; set long delay
77 6F14 01DB
78 6F16 06A0 edml5 bl @scnkey ; scan again
78 6F18 75BE
79 6F1A 8807 c r7,@savkey ; same key as last time?
79 6F1C A028
80 6F1E 1301 jeq edml6 ; if yes then decrement delay
81 6F20 10F0 jmp edml4 ; different key - go process it
82 6F22 0600 edml6 dec r0 ; decrement counter
83 6F24 16F8 jne edml5 ; check again
84 6F26 020D li r13,edml7 ; counter expired. set return point
84 6F28 6F2C
85 6F2A 1011 jmp chkent ; go process key
86 6F2C 0200 edml7 li r0,30 ; shorter (auto-repeat) delay
86 6F2E 001E
87 6F30 10F2 jmp edml5 ; repeat
88 ;]
89
90
91 ;[ do cursorflash
92 6F32 0200 docfl li r0,>0100
92 6F34 0100
93 6F36 A800 a r0,@cursrd
93 6F38 A024
94 6F3A 16E1 jne edml2 ; time to flash cursor? loop if not
95 6F3C 0560 inv @csrflg ; invert the cursor flag
95 6F3E A080
96 6F40 1303 jeq oncsr ; if 0 do cursor on
97 6F42 06A0 bl @csroff ; else do cursor off
97 6F44 737A
98 6F46 10DB jmp edml2
99 6F48 06A0 oncsr bl @csron
99 6F4A 7374
100 6F4C 10D8 jmp edml2
101 ;]
102
103 ;[ check for enter key
104 6F4E 0287 chkent ci r7,keyRET ; return/enter pressed?
104 6F50 000D
105 6F52 1610 jne keycor ; skip if not
106 6F54 04E0 clr @csrx ; move to left most column
106 6F56 A07C
107 6F58 04E0 clr @epage ; move to left page
107 6F5A A07A
108 6F5C 05A0 inc @csry ; move down a line
108 6F5E A07E
109 6F60 C020 mov @csry,r0 ; check y
109 6F62 A07E
110 6F64 0280 ci r0,16 ; 16?
110 6F66 0010
111 6F68 1602 jne keyen1 ; skip if not
112 6F6A 04E0 clr @csry ; clip to 15
112 6F6C A07E
113 6F6E 06A0 keyen1 bl @drawd ; render display
113 6F70 73B6
114 6F72 045D b *r13 ; continue
115 ;]
116
117 ; check control keys
118 ;[ ; check CTRL O (previous block)
119 6F74 0287 keycor ci r7,keyCO
119 6F76 FF8F
120 6F78 160A jne keycpr
121 6F7A C820 mov @lstblk,@temp2
121 6F7C A1B4
121 6F7E A072
122 6F80 0620 dec @temp2 ; decrement block number to load
122 6F82 A072
123 6F84 05C4 rt4th inct stack ; remove BLOCK address from stack
124 6F86 020C li r12,_next ; restore pointer to NEXT
124 6F88 8326
125 6F8A 0460 b @retB0 ; return to forth
125 6F8C 833A
126 ;]
127
128 ;[ ; check CTRL P (next block)
129 6F8E 0287 keycpr ci r7,keyCP
129 6F90 FF90
130 6F92 1606 jne keycdr
131 6F94 C820 mov @lstblk,@temp2
131 6F96 A1B4
131 6F98 A072
132 6F9A 05A0 inc @temp2 ; increment block number to load
132 6F9C A072
133 6F9E 10F2 jmp rt4th ; return to forth
134 ;]
135
136 ;[ ; check CTRL D (delete line)
137 6FA0 0287 keycdr ci r7,keyCD ; ctrl d pressed?
137 6FA2 FF84
138 6FA4 1628 jne keycir ; skip if not
139 6FA6 06A0 bl @needud ; set this blocks' status to dirty
139 6FA8 7616
140 ; calculate end address of buffer
141 6FAA C194 mov *stack,r6 ; vdp buffer address
142 6FAC 0226 ai r6,1023 ; point to last byte of buffer
142 6FAE 03FF
143 ; calculate start point
144 6FB0 C020 mov @csry,r0 ; get current line
144 6FB2 A07E
145 6FB4 0580 inc r0 ; move down a line
146 6FB6 0A60 sla r0,6 ; multiply by buffer line length
147 6FB8 A014 a *stack,r0 ; add vdp buffer start address
148 6FBA 0202 keycd1 li r2,64 ; read a line...
148 6FBC 0040
149 6FBE C060 mov @here,r1 ; ...into scroll buffer
149 6FC0 A046
150 6FC2 06A0 bl @_vmbr ; read the line
150 6FC4 7806
151 6FC6 0220 ai r0,-64 ; move up one line
151 6FC8 FFC0
152 6FCA C060 mov @here,r1 ; source
152 6FCC A046
153 6FCE 0202 li r2,64 ; count
153 6FD0 0040
154 6FD2 06A0 bl @_vmbw0 ; write the line
154 6FD4 7854
155 6FD6 0220 ai r0,128 ; move down 2 lines
155 6FD8 0080
156 6FDA 8180 c r0,r6 ; done all?
157 6FDC 11EE jlt keycd1 ; loop if not
158 ; blank the last line... r6 points to last byte, so...
159 6FDE C006 mov r6,r0 ; place in r0 for VDP
160 6FE0 0220 ai r0,-63 ; move to start of last line in buffer
160 6FE2 FFC1
161 6FE4 0201 li r1,>2000 ; space character
161 6FE6 2000
162 6FE8 0202 li r2,64 ; line length
162 6FEA 0040
163 6FEC 06A0 bl @vsbwmi ; write spaces
163 6FEE 7880
164 6FF0 06A0 bl @rsrc ; render source
164 6FF2 74DC
165 6FF4 045D b *r13 ; continue
166 ;]
167
168 ;[ ; check CTRL I (insert line)
169 6FF6 0287 keycir ci r7,keyCI ; ctrl i pressed?
169 6FF8 FF89
170 6FFA 1628 jne keyccr ; skip if not
171 6FFC 06A0 bl @needud ; set this blocks' status to dirty
171 6FFE 7616
172 ; get current line address
173 7000 C1A0 mov @csry,r6 ; current y
173 7002 A07E
174 7004 0286 ci r6,15 ; on the last line?
174 7006 000F
175 7008 1317 jeq keyci2 ; if so, just erase last line
176 700A 0A66 sla r6,6 ; multiply by line length
177 700C A194 a *stack,r6 ; add vdp buffer address
178 ; find last line of buffer
179 700E C014 mov *stack,r0 ; buffer start address
180 7010 0220 ai r0,14*64 ; move to last line but 1 (15th line)
180 7012 0380
181 7014 C060 keyci1 mov @here,r1 ; buffer address
181 7016 A046
182 7018 0202 li r2,64 ; count
182 701A 0040
183 701C 06A0 bl @_vmbr ; read into buffer
183 701E 7806
184 7020 0220 ai r0,64 ; move down a line
184 7022 0040
185 7024 C060 mov @here,r1 ; buffer address
185 7026 A046
186 7028 0202 li r2,64 ; count
186 702A 0040
187 702C 06A0 bl @_vmbw0 ; write the line
187 702E 7854
188 7030 0220 ai r0,-128 ; move up 2 lines
188 7032 FF80
189 7034 8180 c r0,r6 ; finished?
190 7036 14EE jhe keyci1 ; repeat if not
191 ; erase current line, address is in r6
192 7038 C006 keyci2 mov r6,r0 ; for vdp
193 703A 0201 li r1,>2000 ; space
193 703C 2000
194 703E 0202 li r2,64 ; count
194 7040 0040
195 7042 06A0 bl @vsbwmi ; write 64 spaces
195 7044 7880
196 7046 06A0 bl @rsrc ; render source window
196 7048 74DC
197 704A 045D b *r13 ; continue
198 ;]
199
200 ;[ ; check CTRL C (copy)
201 704C 0287 keyccr ci r7,keyCC ; ctrl C pressed?
201 704E FF83
202 7050 160E jne keyCVr ; skip if not
203 7052 0200 li r0,64 ; buffer pitch
203 7054 0040
204 7056 C060 mov @csry,r1 ; get cursor y
204 7058 A07E
205 705A 3840 mpy r0,r1 ; multiply them (result in r2)
206 705C A094 a *stack,r2 ; add vdp buffer address
207 705E C002 mov r2,r0 ; move to r0 for vdp actions
208 7060 0201 li r1,tib ; destination
208 7062 3420
209 7064 0202 li r2,64 ; number of bytes to read
209 7066 0040
210 7068 06A0 bl @_vmbr ; read them into scroll buffer
210 706A 7806
211 706C 045D b *r13 ; continue
212 ;]
213
214 ;[ ; check CTRL V (paste)
215 706E 0287 keyCVr ci r7,keyCV ; ctrl V pressed?
215 7070 FF96
216 7072 1615 jne keyf1r ; skip if not
217 7074 C020 mov @tib,r0 ; check buffer contents
217 7076 3420
218 7078 1311 jeq nopast ; if 0, nothing to paste
219 707A 0200 li r0,64 ; buffer pitch
219 707C 0040
220 707E C060 mov @csry,r1 ; get cursor y
220 7080 A07E
221 7082 3840 mpy r0,r1 ; multiply them (result in r2)
222 7084 A094 a *stack,r2 ; add vdp buffer address
223 7086 C002 mov r2,r0 ; move to r0 for vdp actions
224 7088 0201 li r1,tib ; source
224 708A 3420
225 708C 0202 li r2,64 ; number of bytes to write
225 708E 0040
226 7090 06A0 bl @_vmbw0 ; write them into source buffer
226 7092 7854
227 7094 06A0 bl @rsrc ; render window
227 7096 74DC
228 7098 06A0 bl @needud ; mark block for update
228 709A 7616
229 709C 045D nopast b *r13 ; continue
230 ;]
231
232 ; check function keys
233 ;[ ; check f1 (del)
234 709E 0287 keyf1r ci r7,keyF1 ; f1 pressed?
234 70A0 0003
235 70A2 162F jne keyf9r ; skip if not
236 70A4 06A0 bl @needud ; set this blocks' status to dirty
236 70A6 7616
237 ; calculate endpoint
238 70A8 C060 mov @csry,r1 ; get y
238 70AA A07E
239 70AC 0581 inc r1 ; move down one line
240 70AE 0A61 sla r1,6 ; multiply by buffer line length (64)
241 70B0 0601 dec r1 ; point to last char on current line
242 70B2 A054 a *stack,r1 ; add in vdp buffer address
243 70B4 C181 mov r1,r6 ; save it
244 ; calculate start point
245 70B6 C0A0 mov @csry,r2 ; get y
245 70B8 A07E
246 70BA 0A62 sla r2,6 ; multiply by buffer line length (64)
247 70BC A0A0 a @csrx,r2 ; add x
247 70BE A07C
248 70C0 A094 a *stack,r2 ; add in vdp address
249 70C2 C020 mov @epage,r0 ; check page
249 70C4 A07A
250 70C6 1302 jeq keyf1s ; skip if 0
251 70C8 0222 ai r2,30 ; account for page offset
251 70CA 001E
252 70CC C002 keyf1s mov r2,r0 ; set start point for vdp read
253 70CE 6042 s r2,r1 ; calculate length
254 70D0 C081 mov r1,r2 ; put in r2 for vmbr
255 70D2 0582 inc r2
256 70D4 C200 mov r0,r8 ; save buffer address
257 70D6 C242 mov r2,r9 ; save length
258 ; read from source buffer
259 70D8 C060 mov @here,r1 ; cpu buffer
259 70DA A046
260 70DC 06A0 bl @_vmbr ; read into buffer
260 70DE 7806
261 70E0 C008 mov r8,r0 ; restore addresds
262 70E2 C089 mov r9,r2 ; restore count
263 70E4 0602 dec r2 ; reduce by 1
264 70E6 1305 jeq f1eol ; if on last column then skip
265 70E8 C060 mov @here,r1 ; move forward...
265 70EA A046
266 70EC 0581 inc r1 ; ...1 char in the buffer
267 70EE 06A0 bl @_vmbw0 ; write it
267 70F0 7854
268 70F2 C006 f1eol mov r6,r0 ; end of line address
269 70F4 0201 li r1,>2000 ; write a space character to end of line
269 70F6 2000
270 70F8 06A0 bl @_vsbw0
270 70FA 782C
271 70FC 06A0 bl @rsrc ; render source to window
271 70FE 74DC
272 7100 045D b *r13 ; continue
273 ;]
274
275 ;[ ; check f9 (back)
276 7102 0287 keyf9r ci r7,keyF9
276 7104 000F
277 7106 1604 jne keyf3r
278 7108 04E0 clr @tib ; clr length byte in TIB to stop Forth from
278 710A 3420
279 ; trying to process the copy/paste buffer as
280 ; input!
281 710C 0460 ret4th b @rt4th ; return to forth
281 710E 6F84
282 ;]
283
284 ;[ ; check f3 (erase line)
285 7110 0287 keyf3r ci r7,keyF3
285 7112 0007
286 7114 1616 jne keyf7r
287 7116 0200 li r0,64 ; buffer pitch
287 7118 0040
288 711A C060 mov @csry,r1 ; get cursor y
288 711C A07E
289 711E 3840 mpy r0,r1 ; multiply them (result in r2)
290 7120 A094 a *stack,r2 ; add vdp buffer address
291 7122 C002 mov r2,r0 ; move to r0 for vdp actions
292 7124 0201 li r1,>2000 ; space character
292 7126 2000
293 7128 0202 li r2,64 ; 64 bytes to erase
293 712A 0040
294 712C 06A0 bl @vsbwmi ; erase them
294 712E 7880
295 7130 04E0 clr @csrx ; move to leftmost column
295 7132 A07C
296 7134 04E0 clr @epage ; left page
296 7136 A07A
297 7138 06A0 bl @rsrc ; render source in window
297 713A 74DC
298 713C 06A0 bl @needud ; set block for update
298 713E 7616
299 7140 045D b *r13 ; continue
300 ;]
301
302 ;[ ; check f7 key
303 7142 0287 keyf7r ci r7,keyF7 ; F7 pressed?
303 7144 0001
304 7146 160A jne keyfqr ; skip if not
305 7148 06A0 bl @is80c ; 80 column mode?
305 714A 767A
306 714C 1306 jeq f7exit ; dump the keypress if yes - f7 key not used
307 ; in 80 column mode
308 714E 06A0 bl @csroff ; restore character under cursor
308 7150 737A
309 7152 0560 inv @epage ; switch page
309 7154 A07A
310 7156 06A0 bl @drawd ; re-draw screen
310 7158 73B6
311 715A 045D f7exit b *r13
312 ;]
313
314 ;[ ; check quit key
315 715C 0287 keyfqr ci r7,keyFeq ; quit pressed?
315 715E 0005
316 7160 160F jne keyf2r ; skip if not
317 7162 C020 edF4 mov @lstblk,r0 ; get current block
317 7164 A1B4
318 7166 06A0 bl @scnblk ; locate it (blk address in r0)
318 7168 69A0
319 716A 04D1 clr *r1 ; un-assign this buffer
320 716C 05C1 inct r1 ; point to VDP address pointer
321 716E C011 mov *r1,r0 ; get the VDP address
322 7170 0240 andi r0,>7fff ; reset dirty bit
322 7172 7FFF
323 7174 C440 mov r0,*r1 ; write it back
324 7176 04E0 clr @tib ; clr length byte in TIB to stop Forth from
324 7178 3420
325 ; trying to process the copy/paste buffer as
326 ; input!
327 717A 06A0 bl @cls_ ; clear screen
327 717C 613A
328 717E 10C6 jmp ret4th ; return to Forth
329 ;]
330
331 ;[ ; check f2 key
332 7180 0287 keyf2r ci r7,keyF2 ; F2 pressed?
332 7182 0004
333 7184 1603 jne keyd ; skip if not
334 7186 06A0 bl @insovr
334 7188 7340
335 718A 045D b *r13
336 ;]
337
338 ;[ ; check for fctn + d
339 718C 0287 keyd ci r7,keyFD ; fctn & d?
339 718E 0009
340 7190 1621 jne keys ; skip if not
341 7192 06A0 bl @csroff ; restore character currently under cursor
341 7194 737A
342 7196 06A0 bl @is80c
342 7198 767A
343 719A 1605 jne keyd1
344 719C C020 mov @csrx,r0
344 719E A07C
345 71A0 0280 ci r0,63
345 71A2 003F
346 71A4 1004 jmp keyd2
347 71A6 C020 keyd1 mov @csrx,r0 ; get cursor x
347 71A8 A07C
348 71AA 0280 ci r0,33 ; check limit
348 71AC 0021
349 71AE 1306 keyd2 jeq clipxh ; clip if on limit
350 71B0 0580 inc r0 ; otherwise increment
351 71B2 C800 mov r0,@csrx ; write it back
351 71B4 A07C
352 71B6 06A0 bl @csron ; set cursor to on state
352 71B8 7374
353 71BA 045D b *r13
354 71BC 04E0 clipxh clr @csrx ; clip cursor
354 71BE A07C
355 71C0 06A0 clipxg bl @is80c ; 80 column?
355 71C2 767A
356 71C4 1306 jeq keydx
357 71C6 0560 inv @epage ; change page
357 71C8 A07A
358 71CA 06A0 bl @drawd ; draw window contents
358 71CC 73B6
359 71CE 06A0 bl @csron ; set cursor to on state
359 71D0 7374
360 71D2 045D keydx b *r13
361 ;]
362
363 ;[ ; check for fctn + s
364 71D4 0287 keys ci r7,keyFS ; fctn & s
364 71D6 0008
365 71D8 1618 jne keye ; skip if not
366 71DA 06A0 bl @csroff ; restore character currently under cursor
366 71DC 737A
367 71DE C020 mov @csrx,r0 ; get cursor x
367 71E0 A07C
368 71E2 1306 jeq clipxl ; clip if on limit
369 71E4 0600 dec r0 ; otherwise decrement
370 71E6 C800 mov r0,@csrx ; write it back
370 71E8 A07C
371 71EA 06A0 bl @csron ; set cursor on
371 71EC 7374
372 71EE 045D b *r13
373 71F0 06A0 clipxl bl @is80c ; 80 column?
373 71F2 767A
374 71F4 1305 jeq clipx2
375 71F6 0200 li r0,33 ; set cursor to the other end
375 71F8 0021
376 71FA C800 mov r0,@csrx ; write it
376 71FC A07C
377 71FE 10E0 jmp clipxg ; change page and render
378 7200 0200 clipx2 li r0,63 ; set cursor to other end (80 col mode)
378 7202 003F
379 7204 C800 mov r0,@csrx
379 7206 A07C
380 7208 045D b *r13
381 ;]
382
383 ;[ ; check for fctn + e
384 720A 0287 keye ci r7,keyFE ; fctn & e
384 720C 000B
385 720E 1610 jne keyx ; skip if not
386 7210 06A0 bl @csroff ; restore character currently under cursor
386 7212 737A
387 7214 C020 mov @csry,r0 ; get cursor y
387 7216 A07E
388 7218 0600 dec r0 ; decrement
389 721A C800 mov r0,@csry ; write it back
389 721C A07E
390 721E 1103 jlt clipyl ; clip if on limit
391 7220 06A0 clipyg bl @csron ; set cursor on
391 7222 7374
392 7224 045D b *r13
393 7226 0200 clipyl li r0,15 ; set cursor to the other end
393 7228 000F
394 722A C800 mov r0,@csry ; write it
394 722C A07E
395 722E 10F8 jmp clipyg
396 ;]
397
398 ;[ ; check for fctn + x
399 7230 0287 keyx ci r7,keyFX ; fctn & x?
399 7232 000A
400 7234 160F jne genkey ; skip if not
401 7236 06A0 bl @csroff ; restore character currently under cursor
401 7238 737A
402 723A C020 mov @csry,r0 ; get cursor y
402 723C A07E
403 723E 0580 inc r0 ; increment it
404 7240 C800 mov r0,@csry ; write it back
404 7242 A07E
405 7244 0280 ci r0,16 ; compare to limit
405 7246 0010
406 7248 1301 jeq clipyh ; clip if on limit
407 724A 10EA jmp clipyg
408 724C 04C0 clipyh clr r0 ; set cursor to the other end
409 724E C800 mov r0,@csry ; write it
409 7250 A07E
410 7252 10E6 jmp clipyg
411 ;]
412
413 ;[ process general keypress
414 7254 06A0 genkey bl @needud ; mark the block for update
414 7256 7616
415 7258 06A0 bl @doins ; do insert if insert mode is selected
415 725A 72EA
416 725C 0200 li r0,64 ; buffer pitch
416 725E 0040
417 7260 C060 mov @csry,r1 ; current y
417 7262 A07E
418 7264 3840 mpy r0,r1 ; calculate buffer address
419 7266 A0A0 a @csrx,r2 ; add x
419 7268 A07C
420 726A C020 mov @epage,r0 ; check page
420 726C A07A
421 726E 1302 jeq gkno ; skip if on page 0
422 7270 0222 ai r2,30 ; else account for page offset
422 7272 001E
423 7274 C002 gkno mov r2,r0 ; move to r0 for vdp address
424 7276 A014 a *stack,r0 ; add vdp buffer address
425 7278 C047 mov r7,r1 ; get keypress
426 727A 06C1 swpb r1 ; move to high byte
427 727C 06A0 bl @_vsbw0 ; write it into vdp
427 727E 782C
428 7280 06A0 bl @csroff ; display it
428 7282 737A
429 7284 C020 mov @csrx,r0 ; get x
429 7286 A07C
430 7288 0580 inc r0 ; move to the right
431 728A C800 mov r0,@csrx ; store it
431 728C A07C
432 728E C060 mov @xmax,r1 ; get xmax
432 7290 A02C
433 7292 0281 ci r1,80 ; 80 column
433 7294 0050
434 7296 1304 jeq chk80 ; jump if in 80 column mode
435 7298 0280 ci r0,34 ; need to clip? (40 column mode check)
435 729A 0022
436 729C 1625 jne upkey ; jump if not
437 729E 100D jmp gkeycx ; else do clip
438 72A0 0280 chk80 ci r0,64 ; limit for 80 column mode
438 72A2 0040
439 72A4 1621 jne upkey ; jump if clip not required
440 72A6 04E0 clr @csrx ; zero x
440 72A8 A07C
441 72AA C020 mov @csry,r0 ; get y
441 72AC A07E
442 72AE 0580 inc r0 ; add 1
443 72B0 0240 andi r0,15 ; clip to 16th line
443 72B2 000F
444 72B4 C800 mov r0,@csry ; store y again
444 72B6 A07E
445 72B8 1017 jmp upkey ; and continue
446 ; clip x and change page
447 72BA 04E0 gkeycx clr @csrx ; zero x
447 72BC A07C
448 72BE 0560 inv @epage ; change page
448 72C0 A07A
449 72C2 1304 jeq ncos ; no cursor offset required if page=0
450 72C4 0200 li r0,4 ; cursor position
450 72C6 0004
451 72C8 C800 mov r0,@csrx ; set it
451 72CA A07C
452 72CC C020 ncos mov @epage,r0 ; get page
452 72CE A07A
453 72D0 1609 jne ncos1 ; skip if page=1
454 72D2 05A0 incyc inc @csry ; move down to next line
454 72D4 A07E
455 72D6 C020 mov @csry,r0 ; check y
455 72D8 A07E
456 72DA 0280 ci r0,16 ; need to clip y
456 72DC 0010
457 72DE 1602 jne ncos1 ; skip if no need
458 72E0 0620 dec @csry ; else reset to 15th line
458 72E2 A07E
459 72E4 06A0 ncos1 bl @drawd ; draw window and rulers etc
459 72E6 73B6
460 72E8 045D upkey b *r13
461 ;]
462
463
464 ;[ insert mode
465 ; move everything *on the current line only* forward, from the cursor
466 72EA C28B doins mov r11,r10
467 72EC C020 mov @temp,r0 ; check insert mode
467 72EE A070
468 72F0 1626 jne doinsx ; if not 0 then exit
469 ; calculate endpoint address in vdp buffer...
470 72F2 C0A0 mov @csry,r2 ; get y
470 72F4 A07E
471 72F6 0582 inc r2 ; move to next line
472 72F8 0A62 sla r2,6 ; multiply by 64
473 72FA 0602 dec r2 ; point to last byte on current line
474 72FC A094 a *stack,r2 ; add in vdp buffer address
475 ; calculate startpoint address in vdp buffer...
476 72FE C020 mov @csry,r0 ; current line
476 7300 A07E
477 7302 0A60 sla r0,6 ; multiply by block line length (64)
478 7304 A020 a @csrx,r0 ; add x
478 7306 A07C
479 7308 C060 mov @epage,r1 ; check page
479 730A A07A
480 730C 1302 jeq doins1 ; skip if page=0
481 730E 0220 ai r0,30 ; else add offset
481 7310 001E
482 7312 A014 doins1 a *stack,r0 ; add in vdp buffer address
483 7314 6080 s r0,r2 ; calculate length
484 7316 1313 jeq doinsx ; exit if 0
485 ; read buffer contents into temporary buffer and write them out again,
486 ; forward by 1 character...
487 7318 C060 mov @here,r1 ; buffer to store the data in
487 731A A046
488 731C C240 mov r0,r9 ; save address
489 731E C202 mov r2,r8 ; save length
490 7320 06A0 bl @_vmbr ; read data into buffer
490 7322 7806
491 7324 C009 mov r9,r0 ; restore address
492 7326 0580 inc r0 ; move forward 1
493 7328 C088 mov r8,r2 ; restore length
494 732A C060 mov @here,r1 ; source for vdp write
494 732C A046
495 732E 06A0 bl @_vmbw0 ; write the characters
495 7330 7854
496 7332 C807 mov r7,@temp3 ; save keypress
496 7334 A074
497 7336 06A0 bl @rsrc ; render source window
497 7338 74DC
498 733A C1E0 mov @temp3,r7 ; restore keypress for handling by keypress
498 733C A074
499 ; routine
500 733E 045A doinsx b *r10
501 ;]
502
503
504 ;[ set insert/overwrite mode
505 7340 C1CB insovr mov r11,r7 ; save return address
506 7342 05A0 inc @temp ; advance to next mode
506 7344 A070
507 7346 8820 c @temp,@modmax ; compare to maximum allowed value
507 7348 A070
507 734A 7372
508 734C 1602 jne ins1 ; if <= to max then ok
509 734E 04E0 clr @temp ; else reset to 0
509 7350 A070
510 7352 06A0 ins1 bl @xya ; set screen address
510 7354 7580
511 7356 2200 data >2200
512 7358 C060 mov @temp,r1 ; get mode
512 735A A070
513 735C 1605 jne ovr ; set insert mode if 1
514 735E 06A0 bl @wstr ; else insert mode 0
514 7360 75B2
515 7362 76FF data instxt,6
515 7364 0006
516 7366 0457 b *r7
517 7368 06A0 ovr bl @wstr ; overwrite (1)
517 736A 75B2
518 736C 7705 data ovrtxt,6
518 736E 0006
519 7370 0457 b *r7
520 7372 0002 modmax data 2
521 ;]
522
523
524 ;[ cursor blinking routines
525 ; display cursor character
526 7374 C18B csron mov r11,r6
527 7376 04C7 clr r7
528 7378 100F jmp calcsr ; calculate cursor position and display r7
529
530 ; restore character under cursor
531 737A C18B csroff mov r11,r6 ; save return address
532 737C C020 mov @csry,r0 ; cursor y
532 737E A07E
533 7380 0A60 sla r0,6 ; multiply by block line pitch (64)
534 7382 A020 a @csrx,r0 ; add x
534 7384 A07C
535 7386 A014 a *stack,r0 ; add buffer address
536 7388 C060 mov @epage,r1 ; check page
536 738A A07A
537 738C 1302 jeq csr1 ; skip if on page 0
538 738E 0220 ai r0,30 ; else add page offset
538 7390 001E
539 7392 06A0 csr1 bl @_vsbr ; read byte from buffer
539 7394 77E4
540 7396 D1C1 movb r1,r7 ; save character
541 7398 C020 calcsr mov @csry,r0 ; cursor y
541 739A A07E
542 739C 0220 ai r0,3 ; account for editor window
542 739E 0003
543 73A0 3820 mpy @xmax,r0 ; multiply by screen pitch (result in r1)
543 73A2 A02C
544 73A4 C020 mov @csrx,r0 ; get x
544 73A6 A07C
545 73A8 0220 ai r0,3 ; account for editor window
545 73AA 0003
546 73AC A001 a r1,r0 ; sum to r0 for vdp address
547 73AE C047 mov r7,r1 ; get the character we saved
548 73B0 06A0 bl @_vsbw0 ; write it
548 73B2 782C
549 73B4 0456 b *r6 ; return to caller
550 ;]
551
552
553 ; screen handling routines
554 ;[ draw dynamic parts of the screen
555 73B6 C28B drawd mov r11,r10 ; save return address
556 ; draw left vertical line
557 73B8 06A0 bl @lftlin
557 73BA 752E
558 ; draw right vertical line
559 73BC 06A0 bl @rtlin
559 73BE 7550
560 ; draw top ruler
561 73C0 06A0 bl @is80c ; 80 column mode?
561 73C2 767A
562 73C4 1310 jeq ru80c ; jump if yes
563 73C6 06A0 bl @xya
563 73C8 7580
564 73CA 0301 data >0301 ; get screen address for x=3 y=1
565 73CC C060 mov @epage,r1
565 73CE A07A
566 73D0 1605 jne trul1
567 73D2 06A0 bl @wstr ; write string
567 73D4 75B2
568 73D6 7684 data txt0,31 ; source,length
568 73D8 001F
569 73DA 1013 jmp ednext
570 73DC 06A0 trul1 bl @wstr ; write string
570 73DE 75B2
571 73E0 76A3 data txt1,31 ; source,length
571 73E2 001F
572 73E4 100E jmp ednext
573 ; render ruler (80 column mode)
574 73E6 06A0 ru80c bl @xya
574 73E8 7580
575 73EA 0301 data >0301 ; get screen address for x=3 y=1
576 73EC 06A0 bl @wstr ; write string
576 73EE 75B2
577 73F0 7684 data txt0,30 ; source,length
577 73F2 001E
578 73F4 06A0 bl @xya
578 73F6 7580
579 73F8 2101 data >2101 ; get screen address for x=33 y=1
580 73FA 06A0 bl @wstr ; write string
580 73FC 75B2
581 73FE 76A3 data txt1,31 ; source,length
581 7400 001F
582
583 ; render block text into editor window
584 ; vdp address is on the stack
585 7402 06A0 ednext bl @rsrc ; render source into window
585 7404 74DC
586 7406 045A b *r10 ; return to caller
587 ;]
588
589 ;[ draw static parts of the screen
590 7408 C28B draws mov r11,r10 ; save return address
591 ; write block text
592 740A 06A0 bl @xya
592 740C 7580
593 740E 0000 data >0000
594 7410 06A0 bl @wstr
594 7412 75B2
595 7414 76F4 data blktxt,6
595 7416 0006
596 ; write mode text
597 7418 06A0 bl @xya
597 741A 7580
598 741C 1D00 data >1d00
599 741E 06A0 bl @wstr
599 7420 75B2
600 7422 76FA data modtxt,5
600 7424 0005
601 ; draw 2nd ruler line
602 7426 06A0 bl @xya
602 7428 7580
603 742A 0302 data >0302 ; get screen address for x=3 y=2
604 742C 06A0 bl @wstr ; write string
604 742E 75B2
605 7430 76C2 data txt2,34 ; source,length
605 7432 0022
606 7434 06A0 bl @is80c ; running 80 column?
606 7436 767A
607 7438 1607 jne lhl ; jump if not
608 743A 06A0 bl @xya
608 743C 7580
609 743E 2502 data >2502 ; x=37 y=2
610 7440 06A0 bl @wstr
610 7442 75B2
611 7444 76C6 data txt2+4,30
611 7446 001E
612 ; draw lower horizontal line
613 7448 06A0 lhl bl @is80c ; in 80 column mode?
613 744A 767A
614 744C 1608 jne lhl1
615 744E 06A0 bl @xya
615 7450 7580
616 7452 0313 data >0313 ; x=3 y=19
617 7454 06A0 bl @hline
617 7456 75A6
618 7458 0100 data 1*256,64
618 745A 0040
619 745C 1007 jmp rownum
620 745E 06A0 lhl1 bl @xya
620 7460 7580
621 7462 0313 data >0313 ; x=3 y=19
622 7464 06A0 bl @hline
622 7466 75A6
623 7468 0100 data 1*256,35
623 746A 0023
624
625 ; place row numbers
626 746C 06A0 rownum bl @xya
626 746E 7580
627 7470 0103 data >0103 ; get screen address for x=1 y=3
628 7472 0202 li r2,16 ; count
628 7474 0010
629 7476 0206 li r6,rowtxt ; source
629 7478 76E4
630 747A D076 rl1 movb *r6+,r1 ; get source character
631 747C 06A0 bl @_vsbw0 ; write a character
631 747E 782C
632 7480 0581 inc r1 ; next source character
633 7482 A020 a @xmax,r0 ; move down a line
633 7484 A02C
634 7486 0602 dec r2 ; finished?
635 7488 16F8 jne rl1 ; loop if not
636 748A 06A0 bl @xya
636 748C 7580
637 748E 000D data >000d ; x=0 y=13
638 7490 06A0 bl @vline
638 7492 7592
639 7494 3100 data '1'*256,6
639 7496 0006
640
641 ; place corner peices
642 7498 0207 li r7,4 ; count
642 749A 0004
643 749C 0206 li r6,cnrdat ; address of corner data
643 749E 74CC
644 74A0 06A0 bl @is80c ; 80 column?
644 74A2 767A
645 74A4 1602 jne corner ; jump if not
646 74A6 0226 ai r6,8 ; else point to 80 column data
646 74A8 0008
647 74AA 0201 corner li r1,4*256 ; ascii 4 in msb
647 74AC 0400
648 74AE C036 crnlp mov *r6+,r0 ; get address
649 74B0 06A0 bl @_vsbw0 ; write to screen
649 74B2 782C
650 74B4 0221 ai r1,>0100 ; increment ascii character
650 74B6 0100
651 74B8 0607 dec r7 ; decrement counter
652 74BA 16F9 jne crnlp ; loop if not finished
653
654 ; draw help text
655 74BC 06A0 bl @xya
655 74BE 7580
656 74C0 0014 data >0014
657 74C2 06A0 bl @wstr
657 74C4 75B2
658 74C6 7743 data help,4*40
658 74C8 00A0
659 74CA 045A b *r10 ; return to caller
660
661 ; location data for corner UDGs - 40 column mode
662 74CC 0052 cnrdat data 2*40+2 ; top left
663 74CE 0075 data 2*40+37 ; top right
664 74D0 02FA data 19*40+2 ; bottom left
665 74D2 031D data 19*40+37 ; bottom right
666
667 ; location data for corner UDGs - 80 column mode
668 74D4 00A2 data 2*80+2 ; top left
669 74D6 00E3 data 2*80+67 ; top right
670 74D8 05F2 data 19*80+2 ; bottom left
671 74DA 0633 data 19*80+67 ; bottom right
672 ;]
673
674 ;[ render source subroutine
675 0000 0023 pitch equ 35
676 74DC C38B rsrc mov r11,r14 ; save return address
677 74DE 020F li r15,pitch ; load pitch for 40 column mode
677 74E0 0023
678 74E2 06A0 bl @is80c
678 74E4 767A
679 74E6 1602 jne rsrc_
680 74E8 020F li r15,65 ; load pitch for 80 column mode
680 74EA 0041
681 74EC 06A0 rsrc_ bl @xya
681 74EE 7580
682 74F0 0303 data >0303 ; screen address
683 74F2 C240 mov r0,r9 ; save it
684 74F4 C194 mov *stack,r6 ; source vdp address
685 74F6 C220 mov @epage,r8 ; check page
685 74F8 A07A
686 74FA 1302 jeq rsrc1
687 74FC 0226 ai r6,30 ; calculate page offset
687 74FE 001E
688 7500 020C rsrc1 li r12,16 ; line count
688 7502 0010
689 7504 C006 rloop mov r6,r0 ; source
690 7506 C060 mov @here,r1 ; destination
690 7508 A046
691 750A C08F mov r15,r2 ; count
692 750C 0602 dec r2
693 750E 06A0 bl @_vmbr ; read a line
693 7510 7806
694 7512 C009 mov r9,r0 ; destination address
695 7514 C060 mov @here,r1 ; source
695 7516 A046
696 7518 C08F mov r15,r2 ; count
697 751A 0602 dec r2
698 751C 06A0 bl @_vmbw0 ; write it
698 751E 7854
699 7520 A260 a @xmax,r9 ; down a line
699 7522 A02C
700 7524 0226 ai r6,64 ; next line in source
700 7526 0040
701 7528 060C dec r12 ; finished?
702 752A 16EC jne rloop ; loop if not
703 752C 045E b *r14 ; return
704 ;]
705
706 ;[ draw left hand vertical line (dependant on which page we're on)
707 752E C1CB lftlin mov r11,r7 ; save return addressd
708 7530 06A0 bl @xya
708 7532 7580
709 7534 0203 data >0203 ; get screen address for x=2 y=3
710 7536 C060 mov @epage,r1 ; get page
710 7538 A07A
711 753A 1605 jne lft1 ; do if page=1
712 753C 06A0 bl @vline
712 753E 7592
713 7540 0300 data 3*256,16
713 7542 0010
714 7544 0457 b *r7
715 7546 06A0 lft1 bl @vline
715 7548 7592
716 754A 9C00 data '<'+96*256,16
716 754C 0010
717 754E 0457 b *r7
718 ;]
719
720 ;[ draw right hand vertical line (dependant on which page we're on)
721 7550 C1CB rtlin mov r11,r7 ; save return address
722 7552 06A0 bl @is80c ; 80 column?
722 7554 767A
723 7556 1310 jeq rt2
724 7558 06A0 bl @xya
724 755A 7580
725 755C 2503 data >2503 ; get screen address for x=37 y=3
726 755E C060 mov @epage,r1 ; get page
726 7560 A07A
727 7562 1605 jne rt1 ; do if page=1
728 7564 06A0 bl @vline
728 7566 7592
729 7568 9E00 data '>'+96*256,16
729 756A 0010
730 756C 0457 b *r7 ; return
731 756E 06A0 rt1 bl @vline
731 7570 7592
732 7572 0300 data 3*256,16
732 7574 0010
733 7576 0457 b *r7 ; return
734 7578 06A0 rt2 bl @xya ; 80 column mode only: place vertical bar on
734 757A 7580
735 ; rhs of screen
736 757C 4303 data >4303
737 757E 10F7 jmp rt1
738 ;]
739
740 ;[ calculate screen address from XY coordinates
741 7580 C03B xya mov *r11+,r0 ; get xy
742 7582 C040 mov r0,r1 ; copy
743 7584 0A81 sla r1,8 ; get y (move x out)
744 7586 0881 sra r1,8 ; adjust to correct position
745 7588 0880 sra r0,8 ; get x (move y out)
746 758A 3860 mpy @xmax,r1 ; do y multiply (result in r2)
746 758C A02C
747 758E A002 a r2,r0 ; screen address in r0
748 7590 045B rt
749 ;]
750
751 ;[ draw a vertical line subroutine
752 ; r0=screen address
753 ; character and length follow as DATA directives in caller code
754 7592 C07B vline mov *r11+,r1
755 7594 C0BB mov *r11+,r2
756 7596 C18B mov r11,r6
757 7598 06A0 vline1 bl @_vsbw0
757 759A 782C
758 759C A020 a @xmax,r0
758 759E A02C
759 75A0 0602 dec r2
760 75A2 16FA jne vline1
761 75A4 0456 b *r6
762 ;]
763
764 ;[ draw a horizontal line subroutine
765 ; r0=screen address
766 ; character and length follow as DATA directives in caller code
767 75A6 C07B hline mov *r11+,r1
768 75A8 C0BB mov *r11+,r2
769 75AA C18B mov r11,r6
770 75AC 06A0 bl @vsbwmi
770 75AE 7880
771 75B0 0456 b *r6
772 ;]
773
774 ;[ write string subroutine
775 ; r0=screen address
776 ; source and length follow as DATA directives in caller code
777 75B2 C07B wstr mov *r11+,r1 ; source
778 75B4 C0BB mov *r11+,r2 ; count
779 75B6 C18B mov r11,r6 ; return address
780 75B8 06A0 bl @_vmbw0 ; write the string
780 75BA 7854
781 75BC 0456 b *r6 ; return
782 ;]
783
784
785
786 ;[ scan keyboard
787 75BE D820 scnkey movb @keybd,@>8374 ; set keyboard to scan
787 75C0 75E8
787 75C2 8374
788 75C4 02E0 lwpi >83e0 ; use gpl workspace
788 75C6 83E0
789 75C8 06A0 bl @>000e ; call keyboard scanning routine
789 75CA 000E
790 ; ########## added for V1.2 ###########
791 ; restore TF workspace
792 ; load a program into r0,r1,r2 & r3 as follows:
793 ; R0=LWPI
794 ; R1=
795 ; R2=BRANCH
796 ; R3=
797 ; ########## added for V1.2 ###########
798 75CC 0200 li r0,>02e0 ; lwpi instruction
798 75CE 02E0
799 75D0 C060 mov @wp,r1 ; lwpi operand
799 75D2 A012
800 75D4 0202 li r2,>0460 ; branch opcode
800 75D6 0460
801 75D8 0203 li r3,scnky1 ; operand for branch instruction
801 75DA 75DE
802 75DC 0440 b r0
803 75DE 04C7 scnky1 clr r7
804 75E0 D1E0 movb @keyin,r7 ; a new key was pressed: get ascii code
804 75E2 8375
805 75E4 0887 sra r7,8 ; move to low byte
806 75E6 045B rt ; return to caller
807 75E8 0500 keybd data >0500 ; all keys
808 ;]
809
810
811 ; miscellaneous routines
812 ;[ delay routine
813 75EA C03B delay mov *r11+,r0
814 75EC 0600 dlylop dec r0
815 75EE 16FE jne dlylop
816 75F0 045B rt
817 ;]
818
819 ;[ define cursor characters and corner edges etc
820 75F2 C18B csrdef mov r11,r6 ; save return address
821 75F4 0200 li r0,>0800 ; ascii 0
821 75F6 0800
822 75F8 0201 li r1,>fc00 ; bit pattern
822 75FA FC00
823 75FC 0202 li r2,7 ; count
823 75FE 0007
824 7600 06A0 bl @vsbwmi
824 7602 7880
825 7604 0200 li r0,>808 ; ascii 1 address
825 7606 0808
826 7608 0201 li r1,ascii1 ; source
826 760A 770B
827 760C 0202 li r2,7*8
827 760E 0038
828 7610 06A0 bl @_vmbw0
828 7612 7854
829 7614 0456 b *r6
830 ;]
831
832
833 ;[ set block status to dirty
834 7616 C18B needud mov r11,r6
835 7618 C020 mov @lstblk,r0 ; get current block
835 761A A1B4
836 761C 06A0 bl @scnblk ; locate it (blk address in r1)
836 761E 69A0
837 7620 05C1 inct r1 ; point to VDP address pointer
838 7622 C011 mov *r1,r0 ; get the VDP address
839 7624 1109 jlt skipud ; skip if already set
840 7626 0260 ori r0,>8000 ; set dirty bit
840 7628 8000
841 762A C440 mov r0,*r1 ; write it back
842 762C 0200 disupd li r0,10 ; screen address
842 762E 000A
843 7630 0201 li r1,'*'*256 ; asterisk in high byte
843 7632 2A00
844 7634 06A0 bl @_vsbw0 ; write to screen
844 7636 782C
845 7638 0456 skipud b *r6
846 ;]
847
848 ;[ display block number
849 763A C38B disblk mov r11,r14
850 763C 0202 li r2,3
850 763E 0003
851 7640 0200 li r0,6
851 7642 0006
852 7644 04C6 clr r6
853 7646 C1E0 mov @lstblk,r7
853 7648 A1B4
854 764A 020A li r10,divs
854 764C 7674
855 764E C23A dislop mov *r10+,r8
856 7650 3D88 div r8,r6
857 7652 C046 mov r6,r1
858 7654 04C6 clr r6
859 7656 0221 ai r1,48
859 7658 0030
860 765A 0A81 sla r1,8
861 765C 06A0 bl @_vsbw0
861 765E 782C
862 7660 0580 inc r0
863 7662 0602 dec r2
864 7664 16F4 jne dislop
865 7666 C047 mov r7,r1
866 7668 0221 ai r1,48
866 766A 0030
867 766C 0A81 sla r1,8
868 766E 06A0 bl @_vsbw0
868 7670 782C
869 7672 045E b *r14
870 7674 03E8 divs data 1000,100,10
870 7676 0064
870 7678 000A
871 ;]
872
873 ;[ check if 80 column mode is on or not...
874 767A C020 is80c mov @xmax,r0 ; get xmax
874 767C A02C
875 767E 0280 ci r0,80 ; compare to 80 (80-column)
875 7680 0050
876 7682 045B rt
877 ;]
878
879 7684 3020 txt0 text '0 1 2 3'
879 7686 2020
879 7688 2020
879 768A 2020
879 768C 2020
879 768E 3120
879 7690 2020
879 7692 2020
879 7694 2020
879 7696 2020
879 7698 3220
879 769A 2020
879 769C 2020
879 769E 2020
879 76A0 2020
879 76A2 33
880 76A3 3320 txt1 text '3 4 5 6'
880 76A5 2020
880 76A7 2020
880 76A9 2020
880 76AB 2020
880 76AD 3420
880 76AF 2020
880 76B1 2020
880 76B3 2020
880 76B5 2020
880 76B7 3520
880 76B9 2020
880 76BB 2020
880 76BD 2020
880 76BF 2020
880 76C1 36
881 76C2 0101 txt2 byte 1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1
881 76C4 0101
881 76C6 0102
881 76C8 0101
881 76CA 0101
881 76CC 0101
881 76CE 0101
881 76D0 0102
881 76D2 0101
881 76D4 0101
881 76D6 0101
881 76D8 0101
881 76DA 0102
881 76DC 0101
881 76DE 0101
881 76E0 01
882 76E1 0101 byte 1,1,1
882 76E3 01
883 ; txt2 byte 48,1,1,1,1,2,1,1,1,1,48,1,1,1,1,2,1,1,1,1,48,1,1,1,1,2,1,1,1,1,48
884 ; byte 1,1,1
885 ; text '0----|----0----|----0----|----0---'
886 76E4 3031 rowtxt text '0123456789012345'
886 76E6 3233
886 76E8 3435
886 76EA 3637
886 76EC 3839
886 76EE 3031
886 76F0 3233
886 76F2 3435
887 76F4 426C blktxt text 'Block:'
887 76F6 6F63
887 76F8 6B3A
888 76FA 4D6F modtxt text 'Mode:'
888 76FC 6465
888 76FE 3A
889 76FF 494E instxt text 'INSERT'
889 7701 5345
889 7703 5254
890 7705 4F56 ovrtxt text 'OVER '
890 7707 4552
890 7709 2020
891
892 ; ascii 1 data ( straight line)
893 770B 0000 ascii1 byte 0,0,0,255,255,0,0,0 ; straight line
893 770D 00FF
893 770F FF00
893 7711 0000
894 ascii2 ; byte 0,0,255,255,16,16,16,0 ; straight line with marker
895 7713 1010 byte 16,16,16,255,255,0,0,0
895 7715 10FF
895 7717 FF00
895 7719 0000
896 771B 3030 ascii3 byte >30,>30,>30,>30,>30,>30,>30,>30 ; vertical line
896 771D 3030
896 771F 3030
896 7721 3030
897 7723 0000 ascii4 byte 0,0,0,>3f,>3f,>30,>30,>30 ; top left corner
897 7725 003F
897 7727 3F30
897 7729 3030
898 772B 0000 ascii5 byte 0,0,0,>f0,>f0,>30,>30,>30 ; top right corner
898 772D 00F0
898 772F F030
898 7731 3030
899 7733 3030 ascii6 byte >30,>30,>30,>3f,>3f,0,0,0 ; bottom left corner
899 7735 303F
899 7737 3F00
899 7739 0000
900 773B 3030 ascii7 byte >30,>30,>30,>f0,>f0,0,0,0 ; bottom right corner
900 773D 30F0
900 773F F000
900 7741 0000
901
902 7743 4631 help text 'F1:Delete F2:Mode F3:Erase Line F7:Page'
902 7745 3A44
902 7747 656C
902 7749 6574
902 774B 6520
902 774D 4632
902 774F 3A4D
902 7751 6F64
902 7753 6520
902 7755 4633
902 7757 3A45
902 7759 7261
902 775B 7365
902 775D 204C
902 775F 696E
902 7761 6520
902 7763 2046
902 7765 373A
902 7767 5061
902 7769 6765
903 776B 4639 text 'F9:Exit F=:Quit ESDX:Cursor ENT:New Line'
903 776D 3A45
903 776F 7869
903 7771 7420
903 7773 463D
903 7775 3A51
903 7777 7569
903 7779 7420
903 777B 4553
903 777D 4458
903 777F 3A43
903 7781 7572
903 7783 736F
903 7785 7220
903 7787 454E
903 7789 543A
903 778B 4E65
903 778D 7720
903 778F 4C69
903 7791 6E65
904 7793 5E43 text '^C:Copy Line ^V:Paste Line ^I:Ins Line'
904 7795 3A43
904 7797 6F70
904 7799 7920
904 779B 4C69
904 779D 6E65
904 779F 2020
904 77A1 5E56
904 77A3 3A50
904 77A5 6173
904 77A7 7465
904 77A9 204C
904 77AB 696E
904 77AD 6520
904 77AF 205E
904 77B1 493A
904 77B3 496E
904 77B5 7320
904 77B7 4C69
904 77B9 6E65
905 77BB 5E44 text '^D:Del Line ^O:Prev Block ^P:Next block'
905 77BD 3A44
905 77BF 656C
905 77C1 204C
905 77C3 696E
905 77C5 6520
905 77C7 5E4F
905 77C9 3A50
905 77CB 7265
905 77CD 7620
905 77CF 426C
905 77D1 6F63
905 77D3 6B20
905 77D5 205E
905 77D7 503A
905 77D9 4E65
905 77DB 7874
905 77DD 2062
905 77DF 6C6F
905 77E1 636B
906 77E3 0000 even
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-12-VDP.a99'
*
1 ; __ _______ _____ _ _ _ _ _ _ _ _
2 ; \ \ / / __ \| __ \ | | | | | (_) (_) | (_)
3 ; \ \ / /| | | | |__) | | | | | |_ _| |_| |_ _ ___ ___
4 ; \ \/ / | | | | ___/ | | | | __| | | | __| |/ _ | __|
5 ; \ / | |__| | | | |__| | |_| | | | |_| | __|__ \
6 ; \/ |_____/|_| \____/ \__|_|_|_|\__|_|\___|___/
7 ; VDP access utility routines
8
9 ;[ vdp single byte read
10 ; inputs: r0=address in vdp to read, r1(msb), the byte read from vdp
11 ; side effects: none
12 77E4 06C0 _vsbr swpb r0
13 77E6 D800 movb r0,@vdpa
13 77E8 8C02
14 77EA 06C0 swpb r0
15 77EC D800 movb r0,@vdpa
15 77EE 8C02
16 77F0 1000 nop
17 77F2 D060 movb @vdpr,r1
17 77F4 8800
18 77F6 045B rt
19 ;]
20
21 ;[ vdp multiple byte read
22 ; inputs: r0=vdp source address, r1=cpu ram destination address
23 ; r2=number of bytes to read
24 ; side effects: r1, r2 & r13 changed
25 77F8 C820 _vmbri mov @bank1_,@retbnk ; return to bank 1
25 77FA 606C
25 77FC A06E
26 77FE 0300 _vmbr2 limi 2
26 7800 0002
27 7802 0300 limi 0
27 7804 0000
28 ; entry point for no interrupts:
29 7806 06C0 _vmbr swpb r0
30 7808 D800 movb r0,@vdpa
30 780A 8C02
31 780C 06C0 swpb r0
32 780E D800 movb r0,@vdpa
32 7810 8C02
33 7812 1000 nop
34 7814 DC60 _vmbr1 movb @vdpr,*r1+
34 7816 8800
35 7818 0602 dec r2
36 781A 16FC jne _vmbr1
37 781C 045B rt
38 ;]
39
40 ;[ vdp single byte write
41 ; inputs: r0=address in vdp to write to, r1(msb)=the byte to write
42 ; side effects: none
43 781E C820 _vsbw mov @bank1_,@retbnk ; return to bank 1
43 7820 606C
43 7822 A06E
44 7824 0300 limi 2
44 7826 0002
45 7828 0300 limi 0
45 782A 0000
46 ; entry point for no interrupts:
47 782C 0260 _vsbw0 ori r0,>4000
47 782E 4000
48 7830 06C0 swpb r0
49 7832 D800 movb r0,@vdpa
49 7834 8C02
50 7836 06C0 swpb r0
51 7838 D800 movb r0,@vdpa
51 783A 8C02
52 783C D801 movb r1,@vdpw
52 783E 8C00
53 7840 2820 xor @_bit1,r0 ; reset bit 1
53 7842 78B6
54 7844 045B rt
55 ;]
56
57 ;[ vdp multiple byte write
58 ; r0=destination in vdp, r1=source address in cpu ram, r2=number of bytes
59 ; side effects: r1, r2 & r13 changed
60 _vmbw
61 7846 C820 mov @bank1_,@retbnk ; return to bank 1
61 7848 606C
61 784A A06E
62 784C 0300 _vmbw2 limi 2
62 784E 0002
63 7850 0300 limi 0
63 7852 0000
64 ; entry point for no interrupts:
65 _vmbw0 ; mov r2,r2 ; check for zero length
66 ; jeq _vmbwx ; if zero then exit
67 7854 0260 ori r0,>4000
67 7856 4000
68 7858 06C0 swpb r0
69 785A D800 movb r0,@vdpa
69 785C 8C02
70 785E 06C0 swpb r0
71 7860 D800 movb r0,@vdpa
71 7862 8C02
72 7864 D831 _vmbw1 movb *r1+,@vdpw
72 7866 8C00
73 7868 0602 dec r2
74 786A 16FC jne _vmbw1
75 786C 2820 xor @_bit1,r0 ; reset bit 1
75 786E 78B6
76 7870 045B _vmbwx rt
77 ;]
78
79 ;[ vdp single byte write many
80 ; writes the same bytes multiple times to consequtive VDP address
81 ; r0=vdp destination address
82 ; r1=the byte to write (in msb)
83 ; r2=number of times to write
84 7872 C820 _vsbwm mov @bank1_,@retbnk ; return to bank 1
84 7874 606C
84 7876 A06E
85 7878 0300 _vsbwm2 limi 2
85 787A 0002
86 787C 0300 limi 0
86 787E 0000
87 ; entry point for no interrupts:
88 7880 0260 vsbwmi ori r0,>4000 ; this is a vdp write command
88 7882 4000
89 7884 06C0 swpb r0 ; low byte first
90 7886 D800 movb r0,@vdpa ; load low byte into address register
90 7888 8C02
91 788A 06C0 swpb r0 ; get high byte
92 788C D800 movb r0,@vdpa ; write high byte
92 788E 8C02
93 7890 D801 _vsbm1 movb r1,@vdpw
93 7892 8C00
94 7894 0602 dec r2 ; decrement count
95 7896 16FC jne _vsbm1 ; loop if not finished
96 7898 2820 xor @_bit1,r0 ; reset bit 1
96 789A 78B6
97 789C 045B rt ; return to caller
98 ;]
99
100 ;[ vdp write to vdp register
101 ; inputs: r0(msb)=the register to write to, r0(lsb)=the value to write
102 ; side effects: none
103 789E 0260 _vwtr ori r0,>8000
103 78A0 8000
104 78A2 06C0 swpb r0
105 78A4 D800 movb r0,@vdpa
105 78A6 8C02
106 78A8 06C0 swpb r0
107 78AA D800 movb r0,@vdpa
107 78AC 8C02
108 78AE 2820 xor @_bit0,r0 ; reset bit 0
108 78B0 78B4
109 78B2 045B rt
110 ;]
111 78B4 8000 _bit0 data >8000 ; used for re-setting bits
112 78B6 4000 _bit1 data >4000
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-13-Stack.a99'
*
1 ; _____ _ _ __ __ _
2 ; / ____| | | | \ \ / / | |
3 ; | (___ | |_ __ _ ___| | __ \ \ /\ / /___ _ __ __| |___
4 ; \___ \| __|/ _` |/ __| |/ / \ \/ \/ // _ \| '__/ _` / __|
5 ; ____) | |_| (_| | (__| < \ /\ /| (_) | | | (_| \__ \
6 ; |_____/ \__|\__,_|\___|_|\_\ \/ \/ \___/|_| \__,_|___/
7 ; Core words pertaining to data and return stack manipulation
8
9 ;[ PICK ( x1 x2 x3 x4 n -- x1 x2 x3 x4 x5 )
10 ; picks the nth value from the data stack and places a copy of it on the top
11 ; of the data stack.
12 ; note: parameters start from 0. 0 PICK is equivalent to DUP.
13 ; 1 PICK is equivalent to OVER
14 78B8 C194 _pick mov *stack,r6 ; get required stack parameter number
15 78BA 0586 inc r6 ; adjust for parameter n on stack
16 78BC 0A16 sla r6,1 ; convert to byte offset
17 78BE A184 a stack,r6 ; add stack address to offset
18 78C0 C516 mov *r6,*stack ; read that address and place on stack
19 78C2 0460 pickx b @retB0 ; NEXT
19 78C4 833A
20 ;]
21
22 ;[ ROLL ( +n -- n )
23 ; The +nth stack value, not counting +n itself is first removed and then
24 ; transferred to the top of the stack, moving the remaining values into the
25 ; vacated position. {0..the number of elements on the stack-1}
26 ; 2 ROLL is equivalent to ROT. 0 ROLL is a null operation
27 78C6 C234 _roll mov *stack+,r8 ; pop roll value in r8
28 78C8 C208 mov r8,r8 ; test for zero value
29 78CA 13FB jeq pickx ; if zero, take no action
30 78CC C284 mov stack,r10 ; copy stack pointer
31 78CE C248 mov r8,r9 ; copy roll value
32 78D0 0A18 sla r8,1 ; multiply by two, to get the offset into
33 ; the stack
34 78D2 A288 a r8,r10 ; compute stack address to start from
35 78D4 C01A mov *r10,r0 ; store stack value, this will go to TOS
36 78D6 C04A mov r10,r1 ; move everything above this stack entry
37 ; back one
38 78D8 064A dect r10 ; source
39 78DA C45A rolllp mov *r10,*r1 ; move source back one word
40 78DC 064A dect r10
41 78DE 0641 dect r1
42 78E0 0609 dec r9 ; decrement counter. finished?
43 78E2 16FB jne rolllp ; loop if not
44 78E4 C500 mov r0,*stack ; place earlier saved value to TOS
45 78E6 10ED exroll jmp pickx ; NEXT
46 ;]
47
48 ;[ DEPTH ( -- depth )
49 ; depth is the number of 16-bit values contained in the data stack before depth
50 ; was placed on the stack.
51 78E8 C1C4 _depth mov stack,r7 ; copy address of TOS
52 78EA 05C7 inct r7
53 78EC C1A0 mov @s0,r6 ; base of stack
53 78EE A01E
54 78F0 6187 s r7,r6 ; subtract tos from base of stack
55 78F2 0816 sra r6,1 ; convert to cells
56 78F4 0644 dect stack ; new stack entry
57 78F6 C506 mov r6,*stack ; push depth
58 78F8 10E4 jmp pickx ; NEXT
59 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-14-File-IO.a99'
*
1 ; ______ _ _ _____ ______
2 ; | ____(_) | |_ _| / / __ \
3 ; | |__ _| | ___ | | / / | | |
4 ; | __| | | |/ _ \ | | / /| | | |
5 ; | | | | | __/ _| |_ / / | |__| |
6 ; |_| |_|_|\___| |_____/_/ \____/
7 ; File IO implementation
8
9 ;[ FILE ( s-addr s-len buf-addr -- )
10 ; Builds a PAB in the buffer whose address is passed as buf_addr using the data
11 ; in the string represented by s_addr and s_len.
12 ; For example:
13 ; FBUF: PRINTER
14 ; S" PIO.CR DV80O" PRINTER FILE
15 ; The above builds a PAB in the buffer called PRINTER which references the PIO
16 ; device. Subsequent file IO words that wish to send data to the PIO shall use
17 ; the buffer name to reference it:
18 ; e.g.
19 ; PRINTER #OPEN DROP ( open PIO and drop success/fail flag)
20 ; S" HELLO WORLD" PRINTER #PUT DROP
21 ; ( write HELLO WORLD to the PIO and drop success/fail flag)
22 ;
23 ; Internally, FILE builds a PAB in the buffer which will be used by #OPEN and
24 ; all file IO words.
25 ; Word 0 of the reserved memory is used to point to the actual PAB in VDP
26 ; memory. Enough space should be reserved (with ALLOT) in the buffer to hold the
27 ; PAB and the filename.
28 ;
29 ; The string which specifies the file name and file characteristics is defined
30 ; as below.
31 ; The filename *must* come first followed by a space character. After that, the
32 ; file options can be specified in any order.
33 ;
34 ; File Options:
35 ; F=Fixed - Fixed record type
36 ; V=Variable - Variable record type
37 ;
38 ; D=Display - Display data type
39 ; L=InternaL - Internal data type
40 ;
41 ; U=Update - Update file mode
42 ; O=Output - Output file mode
43 ; I=Input - Inoput file mode
44 ; A=Append - Append file mode
45 ;
46 ; S=Sequential - Sequential file type
47 ; R=Relative - Relative file type
48 ;
49 ; Note that Internal type files require L
50 ; this is because I is used to specify INPUT
51 78FA 04C8 _file clr r8 ; zero the record length accumulator
52 78FC C2B4 mov *stack+,r10 ; pop buffer address from stack
53 ; zero the first 10 bytes of the alloted buffer
54 ; (holds the PAB data - no need to zero the filename length byte or the
55 ; file, as they'll be populated later)
56 78FE C34A mov r10,r13 ; copy buffer address
57 7900 0201 li r1,10 ; number of bytes to clear
57 7902 000A
58 7904 04FD _ficll clr *r13+ ; clear two bytes in buffer
59 7906 0641 dect r1 ; decrement counter
60 7908 16FD jne _ficll ; repeat if not finished
61 ; transfer filename to PAB...
62 790A 04C6 clr r6 ; byte ops
63 790C C024 mov @2(stack),r0 ; address of string in pad
63 790E 0002
64 7910 C04A mov r10,r1 ; copy buffer address
65 7912 0221 ai r1,12 ; point to 1st filename byte
65 7914 000C
66 7916 04C2 clr r2 ; filename length
67 7918 D1B0 tfnl movb *r0+,r6 ; get a character
68 791A 0614 dec *stack ; decrement string length
69 791C 0286 ci r6,' '*256 ; space?
69 791E 2000
70 7920 1303 jeq wfnlb ; jump if yes
71 7922 DC46 movb r6,*r1+ ; otherwise copy the byte
72 7924 0582 inc r2 ; increment length count
73 7926 10F8 jmp tfnl ; and repeat
74 ; write filename length byte...
75 7928 06C2 wfnlb swpb r2 ; get length in high byte
76 792A DA82 movb r2,@11(r10) ; move length byte into length byte position
76 792C 000B
77 ; process file options...
78 792E D1B0 fdochr movb *r0+,r6 ; get a character
79 7930 0614 dec *stack ; end of string?
80 7932 1127 jlt fdone ; jump if yes
81 7934 0286 ci r6,' '*256 ; is it a space?
81 7936 2000
82 7938 13FA jeq fdochr ; if yes then ignore it
83 793A 0286 ci r6,'9'*256 ; found a digit?
83 793C 3900
84 793E 120A jle fdodig ; if so then do digit
85 ; the option is a character.
86 ; process it against the allowed list of characters
87 7940 0207 li r7,foopts ; pointer to options list
87 7942 79A0
88 7944 020D li r13,10 ; 10 options in the list
88 7946 000A
89 7948 95C6 fnxtop cb r6,*r7 ; compare a character
90 794A 130E jeq ffopt ; jump if match detected
91 794C 0587 inc r7 ; move to next charater in list
92 794E 060D dec r13 ; decrement count
93 7950 16FB jne fnxtop ; check next option
94 7952 10ED jmp fdochr ; check next character
95 ; process numeric digit
96 7954 C248 fdodig mov r8,r9 ; copy accumulator
97 7956 0A38 sla r8,3 ; multiply accumulator by 8
98 7958 0A19 sla r9,1 ; multiply copy by 2
99 795A A209 a r9,r8 ; add them - we just did a multiply by 10
100 ; (MPY needs consecutive registers, and sometimes its just too much
101 ; like hard work, know what I mean?)
102 795C 0986 srl r6,8 ; shift byte into low byte
103 795E 0226 ai r6,-48 ; remove ascii offset
103 7960 FFD0
104 7962 A206 a r6,r8 ; add to accumulator
105 7964 04C6 clr r6 ; byte ops
106 7966 10E3 jmp fdochr ; process next character
107 ; set file option...
108 7968 0227 ffopt ai r7,-20 ; point to appropriate mask byte (the bits
108 796A FFEC
109 ; to reset)
110 796C D06A movb @3(r10),r1 ; get flag byte from PAB
110 796E 0003
111 7970 5057 szcb *r7,r1 ; reset appropriate bit(s)
112 7972 0227 ai r7,10 ; point to bits table (the bits to set)
112 7974 000A
113 7976 F057 socb *r7,r1 ; set appropriate bit(s)
114 7978 DA81 movb r1,@3(r10) ; write it back
114 797A 0003
115 797C 0227 ai r7,10 ; restore pointer
115 797E 000A
116 7980 10D6 jmp fdochr ; process next character in the string
117 7982 06C8 fdone swpb r8 ; get record length in msb
118 7984 DA88 movb r8,@6(r10) ; move it into the pab
118 7986 0006
119 ; dect stack ; pop length
120 ; dect stack ; pop address
121 7988 8D34 c *stack+,*stack+ ; pop length & address
122 798A 106E jmp fexit
123
124 798C 1010 fomask byte >10,>10 ; F & V mask
125 798E 0808 byte >08,>08 ; D & I mask
126 7990 0606 byte >06,>06,>06,>06 ; U O I & A masks
126 7992 0606
127 7994 0101 byte >01,>01 ; S & R masks
128
129 7996 0010 bitmsk byte >00,>10 ; F & V bits
130 7998 0008 byte >00,>08 ; D & I bits
131 799A 0002 byte >00,>02,>04,>06 ; U O I & A bits
131 799C 0406
132 799E 0001 byte >00,>01 ; S & R bits
133 79A0 4656 foopts text 'FVDLUOIASR' ; file options (L=internaL)
133 79A2 444C
133 79A4 554F
133 79A6 4941
133 79A8 5352
134 ;]
135
136 ;[ #OPEN ( file_addr -- t|f )
137 ; Opens a file with the file name and attributes specified in the buffer
138 ; starting at file_addr.
139 ; The buffer (actually a PAB) is set-up with FILE.
140 ; E.g. FBUF: SERIAL
141 ; S" RS232.BA=9600 DV80SO" SERIAL FILE
142 ; SERIAL #OPEN
143 ; The above shall attempt to open the serial port for output as a Display
144 ; Variable 80 type file.
145 ;
146 ; #OPEN leaves a FALSE on the stack if the file was opened sucessfully.
147 ; If the file could not be opened then it leaves a TRUE on the stack.
148 ; This allows easy trapping with ABORT" as shown below:
149 ; SERIAL #OPEN ABORT" Could not open serial port"
150 ;
151 ; In the event of a file error, IOERR can be read to get the DSR error code.
152 ; If IOERR returns -1 (>FFFF) then this means that no free file IO slots were
153 ; found. A maximum of 3 open files is supported (2 if block files are also to
154 ; be used). Note that block files are immediately closed after they are accessed
155 ; for either reading or writing, so 3 generic file io streams are available
156 ; when no blocks files are being used.
157
158 ; find a free file slot...
159 79AA 0200 _fopen li r0,falloc ; address of file allocation table
159 79AC A1AA
160 79AE 0202 li r2,3 ; three slots
160 79B0 0003
161 79B2 C050 nxtslt mov *r0,r1 ; first slot address
162 79B4 1508 jgt foend ; if msb is not set then the slot is empty
163 79B6 05C0 inct r0 ; otherwise move to next slot address
164 79B8 0602 dec r2 ; and try it
165 79BA 16FB jne nxtslt
166 ; no free slots... sorry, no can do...
167 79BC 0720 seto @errnum ; set ioerr to -1 (no available files)
167 79BE A038
168 79C0 0714 seto *stack ; leave a TRUE on the stack
169 79C2 0460 b @retB0
169 79C4 833A
170 ; ok, the slot is free...
171 79C6 C294 foend mov *stack,r10 ; cpu pab address
172 79C8 C681 mov r1,*r10 ; store vdp address of the free PAB in word
173 ; 0 of CPU RAM PAB
174 79CA C081 mov r1,r2 ; copy the vdp address
175 79CC 0262 ori r2,>8000 ; set its most-sig bit to indicate this slot
175 79CE 8000
176 ; is in use
177 79D0 C402 mov r2,*r0 ; write it back falloc table
178 79D2 0221 ai r1,40 ; record buffer in vdp is 40 bytes after PAB
178 79D4 0028
179 79D6 CA81 mov r1,@4(r10) ; store it in bytes 2 & 3 of the PAB
179 79D8 0004
180 79DA 0221 ai r1,-40 ; restore r1 to point to PAB address in VDP
180 79DC FFD8
181 ; transfer the PAB in CPU RAM to the appropriate place in VDP
182 79DE C001 mov r1,r0 ; get in r0 for VMBW
183 79E0 C200 mov r0,r8 ; keep a copy
184 79E2 C04A mov r10,r1 ; source address
185 79E4 05C1 inct r1 ; move past word 0 in CPU PAB (vdp address
186 ; pointer)
187 79E6 0202 li r2,40 ; byte count
187 79E8 0028
188 79EA 06A0 bl @_vmbw0 ; write it to VDP
188 79EC 7854
189 79EE 0228 ai r8,9 ; adjust vdp address copy to point to
189 79F0 0009
190 ; filename length byte
191 79F2 C808 mov r8,@namptr ; store in >8356 as per DSR requirements
191 79F4 8356
192 79F6 0420 blwp @dsrlnk ; call dos
192 79F8 69DE
193 79FA 0008 data 8 ; disk op parameter, level 3 command
194 79FC 1304 jeq _foerr ; jump if an error
195 79FE 04D4 clr *stack ; set top of stack to FALSE (success)
196 7A00 04E0 clr @errnum ; clear io error
196 7A02 A038
197 7A04 1031 jmp fexit
198 ; the file could not be opened
199 7A06 0980 _foerr srl r0,8 ; move error code to lower byte
200 7A08 C800 mov r0,@errnum ; set disk io error number
200 7A0A A038
201 7A0C 0714 seto *stack ; set true flag (failure)
202 7A0E 102C jmp fexit
203 ;]
204
205 ;[ #CLOSE ( fid -- )
206 ; closes a file
207 ; Where a file is opened thus: S" DSK1.README DV80IS" #OPEN MYFILE
208 ; the following will close the same file: MYFILE #CLOSE
209 7A10 06A0 _fclos bl @dodcmd
209 7A12 7B1A
210 7A14 0100 data close*256
211 ; now reset the pab pointer in the file allocation table...
212 ; r13 holds the vdp address of the start of the pab
213 7A16 0201 li r1,falloc ; address of file allocation table
213 7A18 A1AA
214 7A1A 0202 li r2,3 ; 3 entries in the table
214 7A1C 0003
215 7A1E C191 _fclop mov *r1,r6 ; get an entry
216 7A20 0246 andi r6,>7fff ; remove msb
216 7A22 7FFF
217 7A24 8346 c r6,r13 ; found the entry?
218 7A26 1304 jeq _fcfnd ; jump if yes
219 7A28 05C1 inct r1 ; try next word
220 7A2A 0602 dec r2 ; decrement counter
221 7A2C 16F8 jne _fclop ; repeat if not finished
222 7A2E 101C _fcxit jmp fexit
223 7A30 C44D _fcfnd mov r13,*r1 ; move address (with msb reset) back into
224 ; file allocation table
225 7A32 10FD jmp _fcxit
226 ;]
227
228 ;[ #GET ( buff_addr fid -- t|f )
229 ; reads a line of input from the file specified by fid.
230 ; The address of an appropriately sized buffer must be supplied.
231 ; If the read is successful, the buffer is filled with the data read from the
232 ; input device, with the first cell being the length count of the data
233 ; immediately following it.
234 ; This can be converted into a address/length pair with COUNT.
235 ; Returns:
236 ; False if successful
237 ; True if not successful
238 ; This allows trapping with ABORT" as follows:
239 ; MYFILE #GET ABORT" Could not read from the file"
240 ; If the read fails, IOERR is set to the error code, otherwise it is zero'd
241 7A34 06A0 _fget bl @dodcmd ; read from disk
241 7A36 7B1A
242 7A38 0200 data read*256
243 7A3A 1312 jeq _fgerr ; jump if error
244 ; r13 holds the vdp address of the start of the pab
245 7A3C C00D mov r13,r0 ; transfer to r0 for vdp access
246 7A3E 0220 ai r0,5 ; point to character count
246 7A40 0005
247 7A42 06A0 bl @_vsbr ; read the length of the returned record
247 7A44 77E4
248 7A46 C254 mov *stack,r9 ; get cpu ram buffer address from stack
249 7A48 DE41 movb r1,*r9+ ; move length of record to the buffer
250 7A4A D081 movb r1,r2 ; copy length byte to r2 for vdp counter in
251 ; vmbr
252 7A4C 0982 srl r2,8 ; move length byte to low byte of r2
253 7A4E 1306 jeq recln0 ; jump if the record read had a length of 0
254 7A50 C00D mov r13,r0 ; start of pab
255 7A52 0220 ai r0,40 ; point to associated data buffer
255 7A54 0028
256 7A56 C049 mov r9,r1 ; cpu ram buffer address
257 7A58 06A0 bl @_vmbr ; transfer from the buffer in vdp to the
257 7A5A 7806
258 ; buffer in CPU
259 7A5C 04D4 recln0 clr *stack ; place false on stack (succeeded)
260 7A5E 1004 _fgxit jmp fexit
261 ; an error occurred
262 7A60 0980 _fgerr srl r0,8 ; move error code to lower byte
263 7A62 C800 mov r0,@errnum ; set disk io error number
263 7A64 A038
264 7A66 0714 seto *stack ; set stack to true (failed)
265 ; fall down into fexit...
266 ;]
267
268
269
270 7A68 06A0 fexit bl @rstsp ; restore code in scratchpad
270 7A6A 6AEE
271 ; (destroyed by DSR access)
272 7A6C 0460 b @retB0
272 7A6E 833A
273
274
275
276 ;[ #PUT ( buff_addr len fid - t|f )
277 ; Places a string from buffer_addr with length len to the file represented by
278 ; fid.
279 ; Returns false if successful, else returns true.
280 ; This can be trapped with ABORT"
281 7A70 C014 _fput mov *stack,r0 ; get fid
282 7A72 C010 mov *r0,r0 ; get vdp pab address
283 7A74 C064 mov @2(stack),r1 ; get length from stack
283 7A76 0002
284 7A78 06C1 swpb r1 ; move to high byte
285 7A7A 0220 ai r0,5 ; point to length byte in pab
285 7A7C 0005
286 7A7E 06A0 bl @_vsbw0 ; write the length byte to the pab
286 7A80 782C
287 7A82 C1A0 mov @blknum,r6 ; processing a block?
287 7A84 A1B2
288 7A86 1620 jne _fpvdp ; if so then the data we want to write is
289 ; aleady in vdp
290 7A88 0220 ai r0,-3 ; else back up to point data buffer address
290 7A8A FFFD
291 7A8C C054 mov *stack,r1 ; pointer to vdp pab address in r1
292 7A8E C051 mov *r1,r1 ; get the vdp pab address
293 7A90 0221 ai r1,40 ; compute vdp buffer address(pab address+40)
293 7A92 0028
294 7A94 06A0 bl @_vsbw0 ; write msb of address
294 7A96 782C
295 7A98 0580 inc r0 ; advance vdp address
296 7A9A 06C1 swpb r1 ; get lsb
297 7A9C 06A0 bl @_vsbw0 ; write it
297 7A9E 782C
298 7AA0 C014 _fp1 mov *stack,r0 ; get vdp address of pab again
299 7AA2 C010 mov *r0,r0 ; get vdp pab address
300 7AA4 0220 ai r0,40 ; point to record buffer
300 7AA6 0028
301 7AA8 C0A4 mov @2(stack),r2 ; length
301 7AAA 0002
302 7AAC C064 mov @4(stack),r1 ; cpu source address
302 7AAE 0004
303 7AB0 06A0 bl @_vmbw0 ; write to vdp
303 7AB2 7854
304 7AB4 06A0 _fp2 bl @dodcmd
304 7AB6 7B1A
305 7AB8 0300 data write*256
306 7ABA 1303 jeq _fperr ; jump if error
307 7ABC 05C4 inct stack ; pop length
308 7ABE 04D4 clr *stack ; success
309 7AC0 10D3 _fpxit jmp fexit
310 7AC2 05C4 _fperr inct stack ; pop length
311 7AC4 0714 seto *stack ; failed
312 7AC6 10FC jmp _fpxit
313 7AC8 C014 _fpvdp mov *stack,r0 ; vdp address of pab in r0
314 7ACA C010 mov *r0,r0 ; get vdp pab address
315 7ACC 0220 ai r0,2 ; point to data buffer address
315 7ACE 0002
316 7AD0 C064 mov @-4(stack),r1 ; buffer address
316 7AD2 FFFC
317 7AD4 06A0 bl @_vsbw0 ; write msb of address
317 7AD6 782C
318 7AD8 0580 inc r0 ; advance vdp address
319 7ADA 06C1 swpb r1 ; get lsb
320 7ADC 06A0 bl @_vsbw0 ; write it
320 7ADE 782C
321 7AE0 10E9 jmp _fp2
322 ;]
323
324 ;[ #REC ( record# fid -- )
325 ; Sets the record number for reading or writing for relative files
326 7AE2 C034 _frec mov *stack+,r0 ; get fid
327 7AE4 C010 mov *r0,r0 ; get vdp address of associated pab
328 7AE6 0220 ai r0,6 ; point to record number in vdp
328 7AE8 0006
329 7AEA D074 movb *stack+,r1 ; get record number high byte
330 7AEC 06A0 bl @_vsbw0 ; write it
330 7AEE 782C
331 7AF0 0580 inc r0 ; point to record# low byte in pab
332 7AF2 D074 movb *stack+,r1 ; get low byte of record number
333 7AF4 06A0 bl @_vsbw0 ; write it
333 7AF6 782C
334 7AF8 0460 b @retB0
334 7AFA 833A
335 ;]
336
337
338 ;[ #EOF? ( fid -- t|f )
339 ; returns true if currently positioned at the end of the file referenced by fid
340 7AFC 06A0 _feof bl @dodcmd
340 7AFE 7B1A
341 7B00 0900 data status*256
342 7B02 C00D mov r13,r0 ; vdp address of pab to r0
343 7B04 0220 ai r0,8 ; point to screen offset byte (where status
343 7B06 0008
344 ; is stored)
345 7B08 06A0 bl @_vsbr ; read the byte
345 7B0A 77E4
346 7B0C 0241 andi r1,>0100 ; isolate bit 7 (eof bit)
346 7B0E 0100
347 7B10 0A71 sla r1,7 ; move bit to bit 0 (msb)
348 7B12 08F1 sra r1,15 ; shift it back to lsb
349 ; at this point, if bit 7 was 0 then r1 is 0000000000000000(2) (i.e. false)
350 ; if bit 7 was 1 then r1 is 1111111111111111(2) (i.e. true)
351 7B14 0644 dect stack ; make space on stack (dodcmd pops the fid)
352 7B16 C501 mov r1,*stack ; move to stack
353 7B18 10A7 jmp fexit
354 ;]
355
356
357 ;[ Do Disk Command subroutine - executes the disk command passed by the caller
358 7B1A C07B dodcmd mov *r11+,r1 ; get opcode
359 7B1C C38B mov r11,r14 ; save return address
360 7B1E C034 mov *stack+,r0 ; get pointer to cpu ram pab
361 7B20 C010 mov *r0,r0 ; get vdp address of the pab
362 7B22 C340 mov r0,r13 ; copy it (used by #CLOSE, #PUT, #EOF etc)
363 7B24 06A0 docmd1 bl @_vsbw ; write the op-code to the pab
363 7B26 781E
364 ; clear bits 0, 1 & 2 of byte 1 of the PAB...
365 7B28 0580 inc r0 ; move to byte 1 of the pab
366 7B2A 06A0 bl @_vsbr ; read it
366 7B2C 77E4
367 7B2E 0241 andi r1,>1f00 ; reset bits 0,1 & 2
367 7B30 1F00
368 7B32 06A0 bl @_vsbw ; write it back
368 7B34 781E
369 7B36 0220 ai r0,8 ; point to filename length byte
369 7B38 0008
370 7B3A C800 mov r0,@namptr ; load >8356 with pointer to name length as
370 7B3C 8356
371 ; per DSR requirements
372 ; call the DSR...
373 7B3E 0420 blwp @dsrlnk
373 7B40 69DE
374 7B42 0008 data 8
375 7B44 045E b *r14 ; return to caller
376 ;]
377
378 ; close all open files
379 ; called by abort in bank 0
380 7B46 0206 _clall li r6,6 ; offset into file allocation table, and
380 7B48 0006
381 ; also counter
382 7B4A C026 _ca1 mov @falloc(r6),r0 ; get address of PAB in vdp from file
382 7B4C A1AA
383 ; allocation table
384 7B4E C1C0 mov r0,r7 ; copy it
385 7B50 0247 andi r7,>8000 ; check 'in-use' bit
385 7B52 8000
386 7B54 130A jeq _cart ; skip if the entry in the table isn't
387 ; open/in-use
388 7B56 0240 andi r0,>7fff ; reset 'in-use' bit
388 7B58 7FFF
389 7B5A C980 mov r0,@falloc(r6) ; write it back to the file allocation table
389 7B5C A1AA
390 7B5E 020E li r14,_cart ; make #CLOSE return to us ;-)
390 7B60 7B6A
391 7B62 0201 li r1,close*256 ; close opcode for #CLOSE
391 7B64 0100
392 7B66 0460 b @docmd1 ; borrow part of the DODCMD routine to do
392 7B68 7B24
393 ; the work for us ;-)
394 7B6A 0646 _cart dect r6 ; decrement counter
395 7B6C 0286 ci r6,-2 ; finished?
395 7B6E FFFE
396 7B70 16EC jne _ca1 ; close next file if not
397 7B72 0460 b @fexit
397 7B74 7A68
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-15-Initialise.a99'
*
1 ; _____ _ _ _ _ _ _ _
2 ; |_ _| (_) | (_) | (_) | | (_)
3 ; | | _ __ _| |_ _ __ _| |_ ___ __ _| |_ _ ___ _ __
4 ; | | | '_ \| | __| |/ _` | | / __|/ _` | __| |/ _ \| '_ \
5 ; _| |_| | | | | |_| | (_| | | \__ \ (_| | |_| | (_) | | | |
6 ; |_____|_| |_|_|\__|_|\__,_|_|_|___/\__,_|\__|_|\___/|_| |_|
7 ; this code runs at startup to bring TurboForth to life
8
9 ; general initialisation of RAM variables etc
10
11 init
12
13 7B76 C0E0 mov @sumode,r3 ; save graphics startup mode value
13 7B78 A078
14
15 7B7A 0200 li r0,>0190 ; turn the screen off while we set things up
15 7B7C 0190
16 7B7E 06A0 bl @_vwtr
16 7B80 789E
17
18
19 ;[ initialise SAMS card if fitted
20 7B82 020C li r12,>1e00 ; sams CRU base
20 7B84 1E00
21 7B86 1D00 sbo 0 ; enable access to mapper registers
22 7B88 1E01 sbz 1 ; disable mapping while we set it up
23 7B8A 0200 li r0,>4004 ; register for >2000
23 7B8C 4004
24 7B8E 0201 li r1,>f8f8 ; map bank >f8 into >2000
24 7B90 F8F8
25 7B92 CC01 mov r1,*r0+ ; do it
26 7B94 0201 li r1,>f9f9 ; map bank >f9...
26 7B96 F9F9
27 7B98 CC01 mov r1,*r0+ ; ...into >3000
28 ; now set up the banks for high memory...
29 7B9A 0200 li r0,>4014 ; register address
29 7B9C 4014
30 7B9E 0201 li r1,>fafa ; register value
30 7BA0 FAFA
31 7BA2 0202 li r2,6 ; loop count
31 7BA4 0006
32 7BA6 CC01 sams mov r1,*r0+ ; write to the register
33 7BA8 0221 ai r1,>0101 ; next register value
33 7BAA 0101
34 7BAC 0602 dec r2 ; finished?
35 7BAE 16FB jne sams ; loop if not
36 7BB0 1D01 sbo 1 ; enable mapping
37 7BB2 1E00 sbz 0 ; lock the mapper registers
38 ;]
39
40 ;[ clear variables area
41 7BB4 0200 cva li r0,>a000 ; start address
41 7BB6 A000
42 7BB8 0201 li r1,prgtop ; end address
42 7BBA A2C6
43 7BBC 04F0 clrlop clr *r0+ ; clear a word
44 7BBE 8040 c r0,r1 ; finished?
45 7BC0 16FD jne clrlop ; repeat if not
46 ;]
47
48 7BC2 C803 mov r3,@sumode ; restore start up graphics mode
48 7BC4 A078
49 7BC6 C820 mov @>83c0,@seed ; initialise random number seed
49 7BC8 83C0
49 7BCA A076
50
51 ;[ initialise block file system
52 7BCC 04E0 clr @blknum ; clear current block number
52 7BCE A1B2
53 7BD0 0200 li r0,blkvdp ; address of data list
53 7BD2 7D3E
54 7BD4 0201 li r1,blk0 ; destination
54 7BD6 A1B6
55 7BD8 0202 li r2,6 ; loop count
55 7BDA 0006
56 7BDC 04F1 init1 clr *r1+ ; clear blk indicator (0=unassigned)
57 7BDE CC70 mov *r0+,*r1+ ; load blk0 address
58 7BE0 0602 dec r2 ; finished?
59 7BE2 16FC jne init1 ; loop if not
60 ;]
61
62 ;[ set up boot file name (DSK1.BLOCKS)
63 7BE4 0200 li r0,bootfn ; address of boot filename
63 7BE6 7D4A
64 7BE8 0201 li r1,pabnln ; destination
64 7BEA A189
65 7BEC 0202 li r2,12 ; 12 bytes to copy
65 7BEE 000C
66 7BF0 DC70 bootlp movb *r0+,*r1+ ; copy a byte
67 7BF2 0602 dec r2 ; finished?
68 7BF4 16FD jne bootlp ; repeat if not
69 ;]
70
71 ;[ initialise console stuff
72 7BF6 0200 li r0,cursrd ; address of cursor delay
72 7BF8 A024
73 7BFA 04F0 clr *r0+ ; initialise cursor delay
74 7BFC 0730 seto *r0+ ; enable screen scrolling
75 7BFE 04F0 clr *r0+ ; zero current x coordinate
76 7C00 04F0 clr *r0+ ; zero current y coordinate
77 7C02 0200 li r0,>0500 ; keyboard device/scan mode
77 7C04 0500
78 7C06 D800 movb r0,@keydev ; normal (upper/lower case) key scan mode
78 7C08 A022
79
80 ; initialise vdp environment
81 ; disable interrupts, sound and sprites...
82 7C0A 0200 li r0,>8000 ; no sprite motion
82 7C0C 8000
83 ; no auto sound
84 ; no quit key
85 7C0E C800 mov r0,@>83c2 ; see page 4 smart programmer
85 7C10 83C2
86 ; oct 86-vol 2 issue 5
87 ;]
88
89 ;[ load character sets...
90
91 ; initialise control characters to something visible
92 ; we do this by writing the TF logo to ALL 256 characters
93 ; later we define the capital and lower case character sets.
94 7C12 0200 cclop li r0,>800 ; address of ascii 0
94 7C14 0800
95 7C16 0203 li r3,123 ; number of characters to write
95 7C18 007B
96 7C1A 0201 cclop1 li r1,logo ; source (TF logo character)
96 7C1C 7E26
97 7C1E 0202 li r2,8 ; bytes to copy
97 7C20 0008
98 7C22 06A0 bl @_vmbw0 ; write them
98 7C24 7854
99 7C26 0220 ai r0,8 ; next character
99 7C28 0008
100 7C2A 0603 dec r3 ; decrement count
101 7C2C 16F6 jne cclop1 ; loop if not finished
102
103 ; load small ascii character set
104 7C2E 0200 li r0,>08ff ; vdp address of upper case A
104 7C30 08FF
105 7C32 C800 mov r0,@fac ; vdp address for small capitals
105 7C34 834A
106 7C36 0420 blwp @gpllnk ; load small capitals character set
106 7C38 7E54
107 7C3A 0018 data >0018 ; gpl command code
108
109 ; load true lower case characters
110 7C3C 0200 li r0,>b08 ; vdp address of lower case a
110 7C3E 0B08
111 7C40 0201 li r1,lowcas ; source
111 7C42 7D56
112 7C44 0202 li r2,26*8 ; count
112 7C46 00D0
113 7C48 06A0 bl @_vmbw0 ; write true lower case char set
113 7C4A 7854
114
115 ; load curly { | } ~ characters, which for some reason are not loaded by the
116 ; console
117 7C4C 0200 li r0,>bd8 ; vdp destination address
117 7C4E 0BD8
118 7C50 0201 li r1,lbrace ; source
118 7C52 7E2E
119 7C54 0202 li r2,4*8 ; count
119 7C56 0020
120 7C58 06A0 bl @_vmbw0
120 7C5A 7854
121
122 ; load slashed 0
123 7C5C 0200 li r0,>981
123 7C5E 0981
124 7C60 0201 li r1,zerochr
124 7C62 7E4E
125 7C64 0202 li r2,6
125 7C66 0006
126 7C68 06A0 bl @_vmbw0
126 7C6A 7854
127
128 ; initialise inverse characters
129 ; ascii codes 144 to 218 are inverse of 48 to 122
130 7C6C 0205 doinv li r5,>900 ; vdp source
130 7C6E 0900
131 7C70 0206 li r6,>c00 ; vdp destination
131 7C72 0C00
132 7C74 0204 li r4,728 ; count
132 7C76 02D8
133 7C78 C005 invlop mov r5,r0 ; get source address in r0 for VDP ops
134 7C7A 06A0 bl @_vsbr ; go read the vdp data (result in R1)
134 7C7C 77E4
135 7C7E 0541 inv r1 ; invert it
136 7C80 C006 mov r6,r0 ; load destination address
137 7C82 06A0 bl @_vsbw0 ; write r1 to destination address
137 7C84 782C
138 7C86 0585 inc r5 ; advance source address
139 7C88 0586 inc r6 ; advance destination address
140 7C8A 0604 dec r4 ; decrement counter
141 7C8C 16F5 jne invlop ; loop until finished
142
143 7C8E 06A0 bl @csrdef ; define cursor and edge characters
143 7C90 75F2
144 ; (see 1-11-Editor.a99)
145
146 ;]
147
148 ;[ Copy PAD routines into PAD RAM
149 7C92 06A0 bl @rstsp ; use the restore routine in 1-06-Blocks.a99
149 7C94 6AEE
150 ;]
151
152 ;[ general initialisation - initialised from an address/data list
153 7C96 0200 li r0,adrlst ; pointer to address/data table
153 7C98 7CBA
154 7C9A 0202 li r2,33 ; number of items to load
154 7C9C 0021
155 7C9E C070 nxtdat mov *r0+,r1 ; get address to load
156 7CA0 C470 mov *r0+,*r1 ; load the address with data
157 7CA2 0602 dec r2 ; finished?
158 7CA4 16FC jne nxtdat ; loop if not
159 ;]
160
161 ;[ set up data and return stacks...
162 7CA6 0204 li stack,dstack ; data stack pointer
162 7CA8 A2C6
163 7CAA 0205 li rstack,retstk ; return stack pointer
163 7CAC A28A
164
165 7CAE 04E0 clr @spcsvc ; clear speech service routine pointer
165 7CB0 A03E
166
167 7CB2 020C li r12,afteri ; force return point in bank 0
167 7CB4 607A
168 7CB6 0460 b @retB0 ; return to caller in bank 0
168 7CB8 833A
169 ;]
170
171 ;[ initialisation data
172 adrlst
173 7CBA A05C data base, 10 ; default number base
173 7CBC 000A
174 7CBE A02C data xmax, 40 ; 40 column line
174 7CC0 0028
175 7CC2 A02E data ymax, 24 ; 24 rows
175 7CC4 0018
176 7CC6 A044 data latest, lastwd ; last word in the dictionary
176 7CC8 7F10
177 7CCA A046 data here, prgtop ; start of compiled code area
177 7CCC A2C6
178 7CCE A01E data s0, dstack ; start of data stack
178 7CD0 A2C6
179 7CD2 A020 data rs0, retstk ; start of return stack
179 7CD4 A28A
180 7CD6 A01A data ffailm, >2000 ; first free address in low memory
180 7CD8 2000
181 7CDA A01C data ffaihm, himem ; first free address in high memory
181 7CDC A2C6
182 7CDE FFFC data >fffc, wkspc ; pointer to workspace for load-interrupt
182 7CE0 8300
183 7CE2 FFFE data >fffe, startB0 ; pointer to start of code for load-interrupt
183 7CE4 606E
184 7CE6 A06E data retbnk, >6002 ; return to bank 1
184 7CE8 6002
185 7CEA A04A data tibsiz, 80 ; 80 characters input buffer length
185 7CEC 0050
186 7CEE A1CE data tibadr, tib ; location of input buffer
186 7CF0 3420
187 ; (defined in 0-23-System.a99)
188 7CF2 A04E data doboot, 1 ; booting flag (default:on)
188 7CF4 0001
189 7CF6 A050 data sdelim, '"'*256 ; default string delimiter character
189 7CF8 2200
190 7CFA A1B0 data totblk, blocks ; default number of block buffers available
190 7CFC 0006
191 7CFE A000 data intvec, intgo ; default vector for interpret
191 7D00 730A
192 7D02 A002 data blkvec, block2 ; default vector for block
192 7D04 7BA4
193 7D06 A004 data numvec, numbr1 ; default vector for number
193 7D08 6B82
194 7D0A A006 data fndvec, vfind ; default vector for find
194 7D0C 6AE4
195 7D0E A1AA data falloc, f1pab ; address of pab for 1st file
195 7D10 1800
196 7D12 A1AC data falloc+2, f2pab ; address of pab for 2nd file
196 7D14 1928
197 7D16 A1AE data falloc+4, f3pab ; address of pab for 3rd file
197 7D18 1A50
198 7D1A A00E data gplvec, gpllnk ; pointer to gpllnk
198 7D1C 7E54
199 7D1E A010 data padvec, rstsp ; pointer to scratchpad code in bank 1
199 7D20 6AEE
200 7D22 A066 data _WARN, -1 ; default value for warn
200 7D24 FFFF
201 7D26 83C4 data isr, runisr ; pointer to isr launcher in pad
201 7D28 834C
202 7D2A A012 data wp, >8300 ; initial workspace pointer
202 7D2C 8300
203 7D2E A014 data pnext, _next ; address of next
203 7D30 8326
204 7D32 A00C data dsrvec, dsrlnk ; load pointer to DSRLNK vector
204 7D34 69DE
205 7D36 A016 data pdocon, docon ; load pointer to DOCON's executable code
205 7D38 7008
206 7D3A A018 data pcreate, crtime ; load pointer to CREATE's executable code
206 7D3C 6FA4
207
208 ; VDP block buffer addresses for disk block IO...
209 blkvdp
210 7D3E 3020 data bufadd+>1400 ; vdp address of buffer 0
211 7D40 2C20 data bufadd+>1000 ; vdp address of buffer 1
212 7D42 2820 data bufadd+>c00 ; vdp address of buffer 2
213 7D44 2420 data bufadd+>800 ; vdp address of buffer 3
214 7D46 2020 data bufadd+>400 ; vdp address of buffer 4
215 7D48 1C20 data bufadd ; vdp address of buffer 5
216 ; (bufadd defined in 0-23-System.a99)
217
218 ; boot filename - system looks for this file on startup and attempts to load
219 ; from block 1 if found. holding any key supresses this behaviour ala XB.
220 7D4A 0B bootfn byte 11 ; length
221 7D4B 4453 text 'DSK1.BLOCKS' ; file to boot from
221 7D4D 4B31
221 7D4F 2E42
221 7D51 4C4F
221 7D53 434B
221 7D55 53
222 even
223
224 lowcas
225 ; funnelweb editor lower case font:
226 7D56 0000 data >0000,>3808,>7848,>7c00
226 7D58 3808
226 7D5A 7848
226 7D5C 7C00
227 7D5E 4040 data >4040,>7844,>4444,>7800
227 7D60 7844
227 7D62 4444
227 7D64 7800
228 7D66 0000 data >0000,>3844,>4040,>3c00
228 7D68 3844
228 7D6A 4040
228 7D6C 3C00
229 7D6E 0404 data >0404,>3c44,>4444,>3c00
229 7D70 3C44
229 7D72 4444
229 7D74 3C00
230 7D76 0000 data >0000,>3844,>7c40,>3c00
230 7D78 3844
230 7D7A 7C40
230 7D7C 3C00
231 7D7E 1C20 data >1c20,>7820,>2020,>2000
231 7D80 7820
231 7D82 2020
231 7D84 2000
232 7D86 0000 data >0000,>3c44,>443c,>0438
232 7D88 3C44
232 7D8A 443C
232 7D8C 0438
233 7D8E 4040 data >4040,>7844,>4444,>4400
233 7D90 7844
233 7D92 4444
233 7D94 4400
234 7D96 1000 data >1000,>3010,>1010,>3800
234 7D98 3010
234 7D9A 1010
234 7D9C 3800
235 7D9E 0800 data >0800,>1808,>0808,>4830
235 7DA0 1808
235 7DA2 0808
235 7DA4 4830
236 7DA6 2020 data >2020,>2428,>3028,>2400
236 7DA8 2428
236 7DAA 3028
236 7DAC 2400
237 7DAE 3010 data >3010,>1010,>1010,>3800
237 7DB0 1010
237 7DB2 1010
237 7DB4 3800
238 7DB6 0000 data >0000,>7854,>5454,>5400
238 7DB8 7854
238 7DBA 5454
238 7DBC 5400
239 7DBE 0000 data >0000,>7844,>4444,>4400
239 7DC0 7844
239 7DC2 4444
239 7DC4 4400
240 7DC6 0000 data >0000,>3844,>4444,>3800
240 7DC8 3844
240 7DCA 4444
240 7DCC 3800
241 7DCE 0000 data >0000,>7844,>4478,>4040
241 7DD0 7844
241 7DD2 4478
241 7DD4 4040
242 7DD6 0000 data >0000,>3c44,>443c,>0404
242 7DD8 3C44
242 7DDA 443C
242 7DDC 0404
243 7DDE 0000 data >0000,>5c60,>4040,>4000
243 7DE0 5C60
243 7DE2 4040
243 7DE4 4000
244 7DE6 0000 data >0000,>3c40,>3804,>7800
244 7DE8 3C40
244 7DEA 3804
244 7DEC 7800
245 7DEE 0020 data >0020,>7820,>2024,>1800
245 7DF0 7820
245 7DF2 2024
245 7DF4 1800
246 7DF6 0000 data >0000,>4444,>4444,>3c00
246 7DF8 4444
246 7DFA 4444
246 7DFC 3C00
247 7DFE 0000 data >0000,>4444,>2828,>1000
247 7E00 4444
247 7E02 2828
247 7E04 1000
248 7E06 0000 data >0000,>4444,>5454,>2800
248 7E08 4444
248 7E0A 5454
248 7E0C 2800
249 7E0E 0000 data >0000,>4428,>1028,>4400
249 7E10 4428
249 7E12 1028
249 7E14 4400
250 7E16 0000 data >0000,>4424,>1808,>1020
250 7E18 4424
250 7E1A 1808
250 7E1C 1020
251 7E1E 0000 data >0000,>7c08,>1020,>7c00
251 7E20 7C08
251 7E22 1020
251 7E24 7C00
252
253 7E26 00E0 logo data >00e0,>405c,>5018,>1000 ; represents control characters
253 7E28 405C
253 7E2A 5018
253 7E2C 1000
254 7E2E 0018 lbrace data >0018,>2020,>4020,>2018 ; left curly brace (123) {
254 7E30 2020
254 7E32 4020
254 7E34 2018
255 7E36 0010 data >0010,>1010,>0010,>1010 ; bar character (124) |
255 7E38 1010
255 7E3A 0010
255 7E3C 1010
256 7E3E 0030 data >0030,>0808,>0408,>0830 ; right curly brace (125) }
256 7E40 0808
256 7E42 0408
256 7E44 0830
257 7E46 0000 data >0000,>2054,>0800,>0000 ; tilde (126) ~
257 7E48 2054
257 7E4A 0800
257 7E4C 0000
258 7E4E 4C54 zerochr data >4c54,>5454,>6438 ; slashed zero
258 7E50 5454
258 7E52 6438
259 ;]
260
261 ;[ GPLLNK
262 ; This routine is based on the routine published in the July 1986 edition of
263 ; Smart Programmer. Modified by yours truly to allow it be executed from ROM.
264 0000 83E0 gplws equ >83e0 ; GPL workspace
265 0000 83E8 gr4 equ gplws+8 ; GPL R4
266 0000 83EC gr6 equ gplws+12 ; GPL R6
267 0000 8373 stkpnt equ >8373 ; GPL stack pointer
268 0000 0060 ldgadd equ >60 ; load and execute grom address entry point
269 0000 200E xtab27 equ >200e ; low mem XML table location 27
270 0000 166C getstk equ >166c
271
272 ; cpu register data - this data is copied into >200e onwards, so that it sits
273 ; in R7 onwards
274 7E54 2000 gpllnk data glnkws ; [mapped to R7] set up BLWP vectors
275 7E56 7E5E data glink1 ; [mapped to R8]
276 7E58 7E90 rtnad data xmlrtn ; [mapped to R9]
277 7E5A 176C gxmlad data >176c ; [mapped to R10] GROM address for GPL XML 0F27
278 ; opcode
279 7E5C 0050 data >50 ; [mapped to R11] Initialised to >50 where
280 ; PUTSTK address resides
281
282 ; this routine runs in it's own workspace, starting at >2000
283 0000 2000 glnkws equ >2000 ; GPLLNKs workspace of which only registers
284 ; R7 thru R15 are used
285
286 7E5E 0200 glink1 li r0,gpllnk ; we need to copy the cpu register data
286 7E60 7E54
287 7E62 0201 li r1,>200e ; (above) to RAM. R0=Source, R1=Destination
287 7E64 200E
288 7E66 CC70 gpllop mov *r0+,*r1+ ; copy the data above into r7
289 7E68 CC70 mov *r0+,*r1+ ; copy the data above into r8
290 7E6A CC70 mov *r0+,*r1+ ; copy the data above into r9
291 7E6C CC70 mov *r0+,*r1+ ; copy the data above into r10
292 7E6E CC70 mov *r0+,*r1+ ; copy the data above into r11
293 7E70 C81B mov *r11,@gr4 ; put PUTSTK address into R4 of GPL WS
293 7E72 83E8
294 7E74 C83E mov *r14+,@gr6 ; put GPL routine address in r6 of GPL WS
294 7E76 83EC
295 7E78 C809 mov r9,@xtab27 ; put XMLRTN address into >200e
295 7E7A 200E
296 7E7C 02E0 lwpi gplws ; load GPL workspace
296 7E7E 83E0
297 7E80 0694 bl *r4 ; save current GROM address on stack
298 7E82 C920 mov @gxmlad,@>8302(r4) ; push GPL XML address on stack for GPL ret
298 7E84 7E5A
298 7E86 8302
299 7E88 05E0 inct @stkpnt ; adjust the stack pointer
299 7E8A 8373
300 7E8C 0460 b @ldgadd ; execute our GPL routine
300 7E8E 0060
301 7E90 C120 xmlrtn mov @getstk,r4 ; get GETSTK pointer
301 7E92 166C
302 7E94 0694 bl *r4 ; restore GROM address off the stack
303 7E96 02E0 lwpi glnkws ; load our ws
303 7E98 2000
304 7E9A 0380 rtwp ; all done - return to caller
305 ;]
306
307 ;[ Check boot device routine
308 ; this routine is called from 0-01-Startup.a99 to modify the disk boot device
309 ; from DSK1 to DSKx where x is the ascii character of the key held down during
310 ; cartridge boot-up
311 7E9C C014 _cboot mov *stack,r0 ; get key-code from the stack
312 7E9E 0280 ci r0,13 ; enter pressed?
312 7EA0 000D
313 7EA2 1602 jne cboot1 ; jump if not
314 7EA4 04D4 clr *stack ; enter was pressed. zero top of stack to
315 ; supress auto loading.
316 7EA6 1006 jmp cbootx ; return
317 7EA8 0280 cboot1 ci r0,-1 ; nothing pressed?
317 7EAA FFFF
318 7EAC 1303 jeq cbootx ; if nothing pressed then exit routine
319 7EAE 0A80 sla r0,8 ; otherwise move key code move to high byte
320 7EB0 D800 movb r0,@pabfil+3 ; place the digit in cpu PAB
320 7EB2 A18D
321 7EB4 0460 cbootx b @retB0
321 7EB6 833A
322 ;]
323
324 ;[
325 ; ***************************************************
326 ; The following routines are copied to PAD on startup
327 ; ***************************************************
328 ;DOCOL
329 ; Executes a high-level colon definition.
330 ; Saves return address on the return stack, loads new execution thread and
331 ; drops down into NEXT to begin executing the thread.
332 ; Note: These three routines are actually copied to scratchpad ram for extra
333 ; speed. See the equates below for their addresses in PAD
334
335 0000 8320 docol equ >8320 ; address of this routine in PAD
336 7EB8 0645 toRAM dect rstack ; make space on return stack
337 7EBA C543 mov pc,*rstack ; save PC to return stack
338 7EBC C0C6 mov r6,pc ; place in PC and drop down to NEXT
339
340 ;NEXT
341 ; loads the next CFA and branches to the address in the CFA.
342 0000 8326 _next equ docol+6 ; 8326 address of this routine in PAD
343 7EBE C1B3 mov *pc+,r6 ; get CFA in r6
344 7EC0 C1F6 mov *r6+,r7 ; get contents of CFA
345 7EC2 0457 b *r7 ; execute it
346
347 ;EXIT
348 ; exits from a FORTH high level word (i.e. a word entered with DOCOL)
349 0000 832C exit equ _next+6 ; 832c address of this routine in PAD
350 7EC4 832E data exit+2 ; called by NEXT, so needs a pointer
351 7EC6 C0F5 mov *rstack+,pc ; place saved PC into PC & pop return stack
352 7EC8 045C b *next ; do next instruction
353
354 ;BANK1
355 ; routine to perform a bank switch and branch
356 0000 8332 bank1 equ exit+6 ; 8332 address of this routine in PAD
357 7ECA C2DB mov *r11,r11 ; get branch address
358 7ECC 04E0 clr @>6000 ; select bank 1
358 7ECE 6000
359 7ED0 045B b *r11 ; branch to the desired address
360
361 ;RETB0
362 ; routine to return to a calling routine in bank 0
363 0000 833A retB0 equ bank1+8 ; 833a address of this routine in PAD
364 7ED2 04E0 cpypnt clr @>6002 ; select bank 0
364 7ED4 6002
365 7ED6 045C b *next
366
367
368 ; speech synth status routine
369 0000 8340 spstat equ retB0+6
370 7ED8 D820 movb @spchrd,@spdata ; 8340 move data from synth to memory
370 7EDA 9000
370 7EDC 834A
371 7EDE 0BC0 src r0,12 ; wait 12uS - see editor assembler page 349,
372 ; paragraph 5.
373 7EE0 045B rt
374 ; the speech synth status will be placed into the following memory location:
375 0000 834A spdata equ spstat+10
376 7EE2 1000 nop ; 834a dummy space for spdata
377
378 ; routine to call the ISRs in bank1 (actually located 'in' FAC)
379 0000 834C runisr equ spdata+2
380 7EE4 04E0 clr @>6000 ; 834c select bank 1
380 7EE6 6000
381 7EE8 0460 b @isrdes ; jump to ISR despatch handler in bank 1
381 7EEA 607A
382
383 ; ISR return code - select appropriate bank and resume
384 0000 8354 isrxit equ runisr+8
385 7EEC C020 mov @retbnk,r0 ; 8354 get bank to return to
385 7EEE A06E
386 7EF0 04D0 clr *r0 ; select that bank
387 7EF2 045A b *r10 ; return to console ISR routine in console
388 ; ROM
389
390 ; SWAP - runs from high-speed RAM
391 0000 835C _swap equ isrxit+8
392 7EF4 C1D4 mov *stack,r7 ; 835c save TOS
393 7EF6 C524 mov @2(stack),*stack ; move TOS-1 to TOS
393 7EF8 0002
394 7EFA C907 mov r7,@2(stack) ; move previous TOS to TOS-1
394 7EFC 0002
395 7EFE 045C b *next ;
396
397 ; LIT - runs from high-speed RAM
398 0000 8368 _lit equ _swap+12
399 7F00 0644 dect stack ; 8368 create space on the data stack
400 7F02 C533 mov *pc+,*stack ; push in-line number to data stack
401 7F04 045C b *next
402
403 ; DUP - runs from high-speed RAM
404 0000 8382 _dup equ _lit+26 ; >8382 ; (jump over TI reserved PAD locations)
405 7F06 0644 __dup dect stack ; 8382 create stack entry
406 7F08 C524 mov @2(stack),*stack ; mov word @ TOS+1 to TOS
406 7F0A 0002
407 7F0C 045C b *next ;
408
409 ; DROP - runs from high-speed RAM
410 0000 838A _drop equ _dup+8 ; >8388
411 7F0E 05C4 inct stack ; 8388 pop stack
412 7F10 045C b *next ; return
413
414 ; OVER - runs from high-speed RAM
415 0000 838E _over equ _drop+4 ; >838c
416 7F12 0644 dect stack ; 838c move forward one stack position
417 7F14 C524 mov @4(stack),*stack ; copy x1 to TOS
417 7F16 0004
418 7F18 045C b *next ;
419
420 ; 1+ - runs from high-speed RAM
421 0000 8396 _plus1 equ _over+8 ; >8394
422 7F1A 0594 inc *stack ; 8394 increment contents of data stack by 1
423 7F1C 045C b *next ;
424
425 ; 2+ - runs from high-speed RAM
426 0000 839A _plus2 equ _plus1+4 ;
427 7F1E 05D4 inct *stack ; 839c increment contents of data stack by 2
428 7F20 045C b *next ;
429
430 ; 2- - runs from high-speed RAM
431 0000 839E _sub2 equ _plus2+4 ;
432 7F22 0654 dect *stack ; 83a0 decrement contents of data stack by 2
433 7F24 045C b *next ;
434
435 ; + - runs from high-speed RAM
436 0000 83A2 _add equ _sub2+4 ;
437 7F26 A534 a *stack+,*stack ; 83a4 pop tos and add to datastack-1
438 7F28 045C b *next ;
439
440 ; - - runs from high-speed RAM
441 0000 83A6 _sub equ _add+4 ;
442 7F2A 6534 s *stack+,*stack ; 83a8 pop tos and subtract from datastack-1
443 7F2C 045C b *next ;
444
445 ; * - runs from high-speed RAM
446 0000 83AA _mul equ _sub+4 ;
447 7F2E C224 mov @2(stack),r8 ; 83ac word under TOS into r8
447 7F30 0002
448 7F32 3A34 mpy *stack+,r8 ; pop tos and multiply by r8
449 ; (lsw of result in r9)
450 7F34 C509 mov r9,*stack ; place result onto data stack
451 7F36 045C b *next
452
453 ; 0BRANCH
454 0000 83B4 _zbrnch equ _mul+10
455 ; at entry, R3 is pointing at the branch address...
456 7F38 C034 mov *stack+,r0 ; 83b6 test and pop flag
457 7F3A 1602 jne zbq ; if NOT zero, remove from stack and quit
458 7F3C C0D3 mov *pc,pc ; stack was zero, we're taking the jump...
459 ; move address to instruction pointer
460 7F3E 045C b *next
461 7F40 05C3 zbq inct pc ; otherwise move past address
462 7F42 045C b *next
463 padend ; end of secod source block
464 ; end of copy to PAD section
465 ;]
*
* COPY 'C:\TI\Source\TurboForth\Bank1\1-16-End.a99'
*
1 ; _______ _ _ ______ ______ _ _ _____ _
2 ; |__ __| | | | ____| | ____| \ | | __ \ | |
3 ; | | | |__| | |__ | |__ | \| | | | | | |
4 ; | | | __ | __| | __| | . ` | | | | | |
5 ; | | | | | | |____ | |____| |\ | |__| | |_|
6 ; |_| |_| |_|______| |______|_| \_|_____/ (_)
7
8 even
9 7F44 5368 text 'Sheila'
9 7F46 6569
9 7F48 6C61
10 even
11 0000 7F4A endB1 equ $ ; end of bank 1 marker
12 7F4A 0000 end ; so long, and thanks for all the fish
12
Assembly Complete - Errors: 0, Warnings: 0
------ Symbol Listing ------
__DUP ABS:7F06 __dup
_ADD ABS:83A2 _add
_ALIGN ABS:6CFE _align
_ALLOT ABS:6D2C _allot
_BIT0 ABS:78B4 _bit0
_BIT1 ABS:78B6 _bit1
_BLKQ ABS:689E _blkq
_BLOCK ABS:671E _block
_BUF ABS:68B2 _buf
_CA1 ABS:7B4A _ca1
_CART ABS:7B6A _cart
_CBOOT ABS:7E9C _cboot
_CFA ABS:6BF4 _cfa
_CLALL ABS:7B46 _clall
_CLEAN ABS:6870 _clean
_CLS ABS:6132 _cls
_CMOVE ABS:65C0 _cmove
_CMOVF ABS:65D0 _cmovf
_COLOR ABS:63DE _color
_COMAB ABS:6CEE _comab
_COMMA ABS:6CD0 _comma
_COMPI ABS:6D36 _compil
_COPYW ABS:65EE _copyw
_COUNT ABS:6D60 _count
_DATA ABS:66D6 _data
_DCHAR ABS:6298 _dchar
_DEPTH ABS:78E8 _depth
_DIRTY ABS:687C _dirty
_DNOUT ABS:6566 _dnout
_DOWN ABS:6512 _down
_DOWN0 ABS:652A _down0
_DOWN1 ABS:654A _down1
_DOWN2 ABS:655C _down2
_DROP ABS:838A _drop
_DUP ABS:8382 _dup
_DUP2 ABS:6B0A _dup2
_EDIT ABS:6EA2 _edit
_EDIT1 ABS:6EB6 _edit1
_EDIT2 ABS:6EBE _edit2
_EDIT3 ABS:6EC2 _edit3
_FCFND ABS:7A30 _fcfnd
_FCLOP ABS:7A1E _fclop
_FCLOS ABS:7A10 _fclos
_FCXIT ABS:7A2E _fcxit
_FEOF ABS:7AFC _feof
_FGERR ABS:7A60 _fgerr
_FGET ABS:7A34 _fget
_FGXIT ABS:7A5E _fgxit
_FICLL ABS:7904 _ficll
_FILE ABS:78FA _file
_FILL ABS:65AE _fill
_FLUSH ABS:67AE _flush
_FOERR ABS:7A06 _foerr
_FOPEN ABS:79AA _fopen
_FP1 ABS:7AA0 _fp1
_FP2 ABS:7AB4 _fp2
_FPERR ABS:7AC2 _fperr
_FPUT ABS:7A70 _fput
_FPVDP ABS:7AC8 _fpvdp
_FPXIT ABS:7AC0 _fpxit
_FREC ABS:7AE2 _frec
_GCHAR ABS:6280 _gchar
_GMODE ABS:6192 _gmode
_HCHAR ABS:6250 _hchar
_HEADR ABS:6C92 _headr
_HIDE ABS:6D0E _hide
_IMM ABS:6D1C _imm
_JOYST ABS:615A _joyst
_LEFT ABS:643A _left
_LEFT1 ABS:645C _left1
_LIT ABS:8368 _lit
_LWRAP ABS:6456 _lwrap
_MAGFY ABS:62E4 _magfy
_MKBLK ABS:68F0 _mkblk
_MTBUF ABS:6854 _mtbuf
_MUL ABS:83AA _mul
_NEXT ABS:8326 _next
_NTS ABS:6DEC _nts
_NUMBR ABS:6BBA _numbr
_OVER ABS:838E _over
_PANEL ABS:656C _panel
_PICK ABS:78B8 _pick
_PLUS1 ABS:8396 _plus1
_PLUS2 ABS:839A _plus2
_QDIRT ABS:6888 _qdirt
_RIGHT ABS:6478 _right
_RIGHT ABS:649E _right1
_RND ABS:6D42 _rnd
_ROLL ABS:78C6 _roll
_RWRAP ABS:6498 _rwrap
_SAMS ABS:65FE _sams
_SAY ABS:664E _say
_SCREN ABS:63F8 _scren
_SCROL ABS:640A _scrol
_SETBK ABS:68E0 _setbk
_SMLST ABS:638E _smlst
_SPACE ABS:6C90 _space
_SPAN ABS:A04C _span
_SPCOL ABS:630E _spcol
_SPGET ABS:6352 _spget
_SPKNG ABS:662C _spkng
_SPLOC ABS:632C _sploc
_SPMOV ABS:63A4 _spmov
_SPPAT ABS:6370 _sppat
_SPRIT ABS:62B4 _sprit
_STATE ABS:A048 _state
_STR ABS:6DD2 _str
_STREM ABS:6668 _strem
_STRI1 ABS:6DA8 _stri1
_STRI2 ABS:6DBE _stri2
_STRIN ABS:6D8C _strin
_SUB ABS:83A6 _sub
_SUB2 ABS:839E _sub2
_SWAP ABS:835C _swap
_TRAIL ABS:6D6E _trail
_TRCOM ABS:6B9A _trcom
_UP ABS:64BE _up
_UP0 ABS:64CE _up0
_UP1 ABS:64D0 _up1
_UP2 ABS:64F0 _up2
_UP3 ABS:6500 _up3
_UPDAT ABS:6840 _updat
_UPOUT ABS:650A _upout
_USE ABS:66EA _use
_USE3 ABS:66F8 _use3
_VCHAR ABS:625C _vchar
_VMBR ABS:7806 _vmbr
_VMBR1 ABS:7814 _vmbr1
_VMBR2 ABS:77FE _vmbr2
_VMBRI ABS:77F8 _vmbri
_VMBW ABS:7846 _vmbw
_VMBW0 ABS:7854 _vmbw0
_VMBW1 ABS:7864 _vmbw1
_VMBW2 ABS:784C _vmbw2
_VMBWX ABS:7870 _vmbwx
_VSBM1 ABS:7890 _vsbm1
_VSBR ABS:77E4 _vsbr
_VSBW ABS:781E _vsbw
_VSBW0 ABS:782C _vsbw0
_VSBWM ABS:7872 _vsbwm
_VSBWM ABS:7878 _vsbwm2
_VWTR ABS:789E _vwtr
_WARN ABS:A066 _warn
_WORD ABS:6B1A _word
_WWRAP ABS:A00A _wwrap
_ZBRNC ABS:83B4 _zbrnch
AB0RT ABS:7464 ab0rt
AB0RTH ABS:745A ab0rth
ABORT ABS:7432 abort
ABORT_ ABS:7452 abort_
ABORTH ABS:7428 aborth
ABS_ ABS:63F6 abs_
ABSH ABS:63EE absh
ABTTXT ABS:742C abttxt
ADD ABS:631E add
ADDH ABS:6318 addh
ADDTOH ABS:705E addtoh
ADDTOX ABS:7076 addtox
ADRLST ABS:7CBA adrlst
AFTERI ABS:607A afteri
AGAIN ABS:66A0 again
AGAINH ABS:6696 againh
AHEAD ABS:6564 ahead
ALIGN ABS:70EC align
ALIGNH ABS:70E2 alignh
ALLFIN ABS:71EE allfin
ALLOT ABS:70A2 allot
ALLOTH ABS:7098 alloth
ALTCFA ABS:6FAA altcfa
AND ABS:67D2 and
ANDH ABS:67CA andh
ASCII ABS:78D8 ascii
ASCII1 ABS:770B ascii1
ASCII2 ABS:7713 ascii2
ASCII3 ABS:771B ascii3
ASCII4 ABS:7723 ascii4
ASCII5 ABS:772B ascii5
ASCII6 ABS:7733 ascii6
ASCII7 ABS:773B ascii7
ASCIIH ABS:78CE asciih
ASCIIX ABS:78E6 asciix
AUTORL ABS:A084 autorl
AUTORP ABS:A082 autorp
BACK1 ABS:6A20 back1
BACK2 ABS:6A24 back2
BADBK1 ABS:73B6 badbk1
BADBLK ABS:73AA badblk
BALTXT ABS:7596 baltxt
BANK0 ABS:606A bank0
BANK1 ABS:8332 bank1
BANK1_ ABS:606C bank1_
BASE ABS:A05C base
BASE_ ABS:76FC base_
BASEH ABS:76F4 baseh
BCLEAN ABS:7CC4 bclean
BEGCNT ABS:A086 begcnt
BEGERR ABS:71DC begerr
BEGIN ABS:6670 begin
BEGINH ABS:6666 beginh
BEGTXT ABS:7581 begtxt
BFREE ABS:699E bfree
BIT1 ABS:695E bit1
BITMSK ABS:7996 bitmsk
BL_ ABS:6AC8 bl_
BLCTXT ABS:75B9 blctxt
BLH ABS:6AC2 blh
BLK ABS:7B4E blk
BLK0 ABS:A1B6 blk0
BLK1 ABS:A1BA blk1
BLK2 ABS:A1BE blk2
BLK3 ABS:A1C2 blk3
BLK4 ABS:A1C6 blk4
BLK5 ABS:A1CA blk5
BLKERR ABS:679A blkerr
BLKFB ABS:6740 blkfb
BLKH ABS:7B46 blkh
BLKMSG ABS:75CB blkmsg
BLKNIM ABS:6738 blknim
BLKNUM ABS:A1B2 blknum
BLKNXT ABS:676C blknxt
BLKQ ABS:7CF8 blkq
BLKQH ABS:7CF0 blkqh
BLKTXT ABS:76F4 blktxt
BLKVDP ABS:7D3E blkvdp
BLKVEC ABS:A002 blkvec
BLNKLN ABS:6EF6 blnkln
BLOAD1 ABS:7DF0 bload1
BLOAD2 ABS:7E2E bload2
BLOADH ABS:7DE4 bloadh
BLOCK ABS:7B98 block
BLOCK2 ABS:7BA4 block2
BLOCKH ABS:7B8E blockh
BLOCKS ABS:0006 blocks
BNFB ABS:6790 bnfb
BOOTFN ABS:7D4A bootfn
BOOTLP ABS:7BF0 bootlp
BOOTUP ABS:60D6 bootup
BRANCH ABS:65E4 branch
BREAK ABS:6C54 break
BREAK1 ABS:6C6E break1
BREAKH ABS:6C4A breakh
BRKMSG ABS:6C70 brkmsg
BRNCHH ABS:65DA brnchh
BSAVE ABS:7D7E bsave
BSAVE1 ABS:7D88 bsave1
BSAVE2 ABS:7DC2 bsave2
BSAVEH ABS:7D74 bsaveh
BUF ABS:7D08 buf
BUFADD ABS:1C20 bufadd
BUFH ABS:7D00 bufh
BUFRPT ABS:68BC bufrpt
BUFXIT ABS:68DC bufxit
BUMPY ABS:6A2A bumpY
BYE ABS:6F2E bye
BYEH ABS:6F26 byeh
CALCSR ABS:7398 calcsr
CASCHK ABS:6B4E caschk
CASCNT ABS:A082 cascnt
CASE ABS:6600 case
CASEH ABS:65F8 caseh
CASERR ABS:71B8 caserr
CASOUT ABS:6B6A casout
CASSEN ABS:A056 cassen
CASTXT ABS:756D castxt
CBA ABS:6978 cba
CBOOT ABS:6106 cboot
CBOOT1 ABS:7EA8 cboot1
CBOOTX ABS:7EB4 cbootx
CCLOP ABS:7C12 cclop
CCLOP1 ABS:7C1A cclop1
CCOMMA ABS:70DA ccomma
CCOMMH ABS:70D4 ccommh
CCP ABS:6F14 ccp
CELLP ABS:62DA cellp
CELLPH ABS:62D0 cellph
CELLS ABS:6306 cells
CELLSH ABS:62FC cellsh
CFA ABS:6BF2 cfa
CFAH ABS:6BEA cfah
CFLASH ABS:6E22 cflash
CHAR ABS:78C4 char
CHARH ABS:78BC charh
CHARP ABS:62E6 charp
CHARPH ABS:62DC charph
CHARS ABS:68A4 chars
CHARSH ABS:689A charsh
CHK80 ABS:72A0 chk80
CHKENT ABS:6F4E chkent
CHKNUM ABS:734C chknum
CHRFH ABS:6868 chrfh
CHRFTC ABS:686E chrftc
CLC ABS:60AC clc
CLEAN ABS:7366 clean
CLEAN1 ABS:738C clean1
CLEANH ABS:7CBA cleanh
CLIPX ABS:6DBC clipx
CLIPX2 ABS:7200 clipx2
CLIPXG ABS:71C0 clipxg
CLIPXH ABS:71BC clipxh
CLIPXL ABS:71F0 clipxl
CLIPYG ABS:7220 clipyg
CLIPYH ABS:724C clipyh
CLIPYL ABS:7226 clipyl
CLOAD ABS:7C68 cload
CLOAD1 ABS:7C78 cload1
CLOADH ABS:7C5E cloadh
CLOSE ABS:0001 close
CLRLOP ABS:7BBC clrlop
CLS ABS:6D76 cls
CLS_ ABS:613A cls_
CLSALL ABS:7496 clsall
CLSH ABS:6D6E clsh
CMOVE ABS:6982 cmove
CMOVEH ABS:6978 cmoveh
CMOVF ABS:6994 cmovf
CMOVFH ABS:698A cmovfh
CMOVLP ABS:65C8 cmovlp
CMVEXT ABS:65EA cmvext
CMVFLP ABS:65E0 cmvflp
CNRDAT ABS:74CC cnrdat
CNXTCH ABS:6B06 cnxtch
CODEH ABS:7148 codeh
CODING ABS:A068 coding
COL32D ABS:6234 col32d
COL40D ABS:622A col40d
COL80D ABS:623E col80d
COLD ABS:6166 cold
COLDH ABS:615C coldh
COLNAM ABS:74CE colnam
COLNM1 ABS:74E4 colnm1
COLON ABS:7116 colon
COLONH ABS:7110 colonh
COLOR ABS:7A4C color
COLORH ABS:7A42 colorh
COMBRA ABS:60A4 combra
COMMA ABS:70CC comma
COMMAH ABS:70C6 commah
COMMAX ABS:6CEA commax
COMPIH ABS:7256 compih
COMPIL ABS:7262 compile
COMXIT ABS:6BB8 comxit
CONST ABS:6FFC const
CONSTH ABS:6FF0 consth
CONT ABS:691A cont
COPYW ABS:69C0 copyw
COPYWH ABS:69B6 copywh
COPYWL ABS:65F6 copywl
CORNER ABS:74AA corner
COUNT ABS:78F2 count
COUNTH ABS:78E8 counth
CPL ABS:7668 cpl
CPLH ABS:7660 cplh
CPYPNT ABS:7ED2 cpypnt
CR ABS:6E92 cr
CREATE ABS:6F9A create
CREATH ABS:6F90 creath
CREXIT ABS:6EA8 crexit
CRH ABS:6E8C crh
CRNLP ABS:74AE crnlp
CRTIME ABS:6FA4 crtime
CRTLP ABS:6CB8 crtlp
CSING ABS:73A4 csing
CSR1 ABS:7392 csr1
CSRDEF ABS:75F2 csrdef
CSRFLG ABS:A080 csrflg
CSROFF ABS:737A csroff
CSRON ABS:7374 csron
CSRWRT ABS:6E4E csrwrt
CSRX ABS:A07C csrx
CSRY ABS:A07E csry
CSTART ABS:60D4 cstart
CURSRD ABS:A024 cursrd
CVA ABS:7BB4 cva
DATA1 ABS:7ADE data1
DATA2 ABS:7AEA data2
DATA8 ABS:6AE8 data8
DATAH ABS:7AC0 datah
DATCR ABS:6A64 datCR
DCHAR ABS:79A6 dchar
DCHARH ABS:799C dcharh
DECH ABS:77D0 dech
DECI ABS:77DC deci
DECMAL ABS:6AEA decmal
DELAY ABS:75EA delay
DELKEY ABS:0003 delkey
DEPTH ABS:6240 depth
DEPTHH ABS:6236 depthh
DFA ABS:6C1E dfa
DFA1 ABS:6C24 dfa1
DFAFND ABS:6C46 dfafnd
DFAH ABS:6C14 dfah
DIRTIH ABS:7CDE dirtih
DIRTY ABS:7CD6 dirty
DIRTYH ABS:7CCC dirtyh
DIRTYQ ABS:7CE8 dirtyq
DISBLK ABS:763A disblk
DISKIO ABS:69B8 diskio
DISLOP ABS:764E dislop
DISUPD ABS:762C disupd
DIV2 ABS:630E div2
DIV2H ABS:6308 div2h
DIVS ABS:7674 divs
DLENTR ABS:69E2 dlentr
DLY42 ABS:611A dly42
DLYLOP ABS:75EC dlylop
DO ABS:66F6 do
DO1 ABS:66DA do1
DO1H ABS:66D4 do1h
DOBOOT ABS:A04E doboot
DOCFL ABS:6F32 docfl
DOCMD1 ABS:7B24 docmd1
DOCNT ABS:A07E docnt
DOCOL ABS:8320 docol
DOCON ABS:7008 docon
DODCMD ABS:7B1A dodcmd
DODIG ABS:6E56 dodig
DODIV ABS:6E24 dodiv
DODOES ABS:6FB6 dodoes
DOERR ABS:71A6 doerr
DOERTX ABS:755F doertx
DOES ABS:6FE6 does
DOESH ABS:6FDC doesh
DOH ABS:66EE doh
DOINS ABS:72EA doins
DOINS1 ABS:7312 doins1
DOINSX ABS:733E doinsx
DOINV ABS:7C6C doinv
DOMARK ABS:6F84 domark
DOPTO ABS:7084 dopto
DOSIGN ABS:A064 dosign
DOT ABS:783C dot
DOT1 ABS:7840 dot1
DOTH ABS:7836 doth
DOTO ABS:7056 doto
DOTOH ABS:704E dotoh
DOTR ABS:7860 dotr
DOTRH ABS:785A dotrh
DOTS ABS:624E dots
DOTS1 ABS:6260 dots1
DOTS3 ABS:6274 dots3
DOTS4 ABS:6276 dots4
DOTSIN ABS:A05A dotsin
DOTST ABS:627C dotst
DOTTXT ABS:6284 dottxt
DOVAR ABS:7756 dovar
DOVDP2 ABS:621C dovdp2
DOWWRA ABS:6CB6 dowwrap
DPL ABS:A054 dpl
DRAWD ABS:73B6 drawd
DRAWS ABS:7408 draws
DROP ABS:6172 drop
DROP2 ABS:75E0 drop2
DROP2H ABS:75D6 drop2h
DROPH ABS:616A droph
DSRDT8 ABS:6ACE dsrdt8
DSRDTA ABS:6AD2 dsrdta
DSRLNK ABS:69DE dsrlnk
DSRLWS ABS:A156 dsrlws
DSRVEC ABS:A00C dsrvec
DSTACK ABS:A2C6 dstack
DSTYPE ABS:A160 dstype
DUP ABS:6186 dup
DUP0H ABS:61F4 dup0h
DUP2 ABS:75EE dup2
DUP2H ABS:75E6 dup2h
DUPH ABS:617E duph
ECODE ABS:7170 ecode
ECODEH ABS:7166 ecodeh
EDBLK ABS:A086 edblk
EDF4 ABS:7162 edF4
EDIT ABS:7F18 edit
EDIT_ ABS:7F30 edit_
EDIT0 ABS:7F3A edit0
EDIT1 ABS:7F54 edit1
EDIT3 ABS:7F58 edit3
EDITH ABS:7F10 edith
EDML2 ABS:6EFE edml2
EDML3 ABS:6F12 edml3
EDML4 ABS:6F02 edml4
EDML5 ABS:6F16 edml5
EDML6 ABS:6F22 edml6
EDML7 ABS:6F2C edml7
EDNEXT ABS:7402 ednext
ELSE ABS:65CC else
ELSEH ABS:65C4 elseh
EMIT ABS:6D98 emit
EMIT_ ABS:6DA0 emit_
EMITH ABS:6D90 emith
ENDB0 ABS:7FF0 endB0
ENDB1 ABS:7F4A endB1
ENDCAH ABS:6640 endcah
ENDCAS ABS:664C endcas
ENDOF ABS:6634 endof
ENDOFH ABS:662A endofh
EPAGE ABS:A07A epage
EQ ABS:647A eq
EQH ABS:6474 eqh
EQZ ABS:64D2 eqz
EQZH ABS:64CC eqzh
ERRNUM ABS:A038 errnum
ERROR ABS:752C error
ERRTXT ABS:7590 errtxt
ERRXIT ABS:7500 errxit
EVAL ABS:6B96 eval
EVALH ABS:6B8A evalh
EXECUT ABS:72AA execut
EXEH ABS:729E exeh
EXIT ABS:832C exit
EXITH ABS:610E exith
EXITT ABS:6116 exitt
EXP1 ABS:6A52 exp1
EXP2 ABS:6A5A exp2
EXPCNT ABS:A060 expcnt
EXPCTH ABS:69C8 expcth
EXPECT ABS:69D2 expect
EXPNXT ABS:69E2 expnxt
EXROLL ABS:78E6 exroll
F1BUF ABS:1828 f1buf
F1EOL ABS:70F2 f1eol
F1PAB ABS:1800 f1pab
F2BUF ABS:1950 f2buf
F2PAB ABS:1928 f2pab
F3BUF ABS:1A78 f3buf
F3PAB ABS:1A50 f3pab
F7EXIT ABS:715A f7exit
FAC ABS:834A fac
FADDPH ABS:6838 faddph
FALLOC ABS:A1AA falloc
FALSE ABS:7800 false
FALSEH ABS:77F6 falseh
FBLOCK ABS:7C52 fblock
FBUF ABS:7E5C fbuf
FBUFH ABS:7E52 fbufh
FCLOSE ABS:7E84 fclose
FCLOSH ABS:7E7A fclosh
FDOCHR ABS:792E fdochr
FDODIG ABS:7954 fdodig
FDONE ABS:7982 fdone
FEOF ABS:7EC6 feof
FEOFH ABS:7EBC feofh
FETCH ABS:6830 fetch
FETCHH ABS:682A fetchh
FEXIT ABS:7A68 fexit
FFAHH ABS:7746 ffahh
FFAIH ABS:7750 ffaih
FFAIHM ABS:A01C ffaihm
FFAILM ABS:A01A ffailm
FFALH ABS:775C ffalh
FFAML ABS:7766 ffaml
FFOPT ABS:7968 ffopt
FGET ABS:7E94 fget
FGETH ABS:7E8C fgeth
FILE1 ABS:7E4A file1
FILEH ABS:7E42 fileh
FILL ABS:6970 fill
FILLH ABS:6968 fillh
FILLLP ABS:65B8 filllp
FIND ABS:6AD8 find
FIND1 ABS:6AF8 find1
FIND2 ABS:6B14 find2
FINDER ABS:72D0 finderr
FINDH ABS:6AD0 findh
FLERR ABS:6832 flerr
FLEXIT ABS:6828 flexit
FLGPTR ABS:A154 flgptr
FLNEXT ABS:67C2 flnext
FLNREC ABS:67F4 flnrec
FLOOR ABS:6446 floor
FLOOR1 ABS:6458 floor1
FLUSH ABS:7C98 flush
FLUSH1 ABS:67B4 flush1
FLUSH2 ABS:6814 flush2
FLUSHH ABS:7C8E flushh
FLUSHX ABS:67B2 flushx
FNDBLK ABS:69B6 fndblk
FNDBUF ABS:68D4 fndbuf
FNDNXT ABS:6AEC fndnxt
FNDVEC ABS:A006 fndvec
FNEXT1 ABS:658C fnext1
FNXTOP ABS:7948 fnxtop
FOEND ABS:79C6 foend
FOMASK ABS:798C fomask
FOOPTS ABS:79A0 foopts
FOPEN1 ABS:7E72 fopen1
FOPENH ABS:7E68 fopenh
FOR ABS:6576 for
FORCNT ABS:A080 forcnt
FORG1 ABS:7408 forg1
FORGET ABS:73EE forget
FORGTH ABS:73E4 forgth
FORH ABS:656E forh
FPUT ABS:7EA4 fput
FPUTH ABS:7E9C fputh
FREBUF ABS:6988 frebuf
FREC ABS:7EB4 frec
FRECH ABS:7EAC frech
FREEH ABS:699C freeh
FRMDSR ABS:6ABE frmdsr
FTCHPP ABS:6840 ftchpp
FVMBR ABS:6902 fvmbr
FVMBW ABS:6912 fvmbw
FWDREW ABS:0004 fwdrew
GABORT ABS:65A6 gabort
GCHAR ABS:7994 gchar
GCHARH ABS:798A gcharh
GENKEY ABS:7254 genkey
GET2 ABS:659A get2
GET4 ABS:6592 get4
GETI ABS:679A geti
GETIH ABS:6794 getih
GETJ ABS:67AC getj
GETJH ABS:67A6 getjh
GETSTK ABS:166C getstk
GETWOR ABS:72BA getword
GEXIT ABS:6258 gexit
GEXIT1 ABS:63F4 gexit1
GEXIT2 ABS:650E gexit2
GHERE ABS:780E ghere
GKEYCX ABS:72BA gkeycx
GKNO ABS:7274 gkno
GLINK1 ABS:7E5E glink1
GLNKWS ABS:2000 glnkws
GMODE ABS:795E gmode
GMODEH ABS:7954 gmodeh
GMODEX ABS:6228 gmodex
GOTOXY ABS:6C80 gotoxy
GOXYH ABS:6C76 goxyh
GPLLNK ABS:7E54 gpllnk
GPLLOP ABS:7E66 gpllop
GPLST ABS:837C gplst
GPLVEC ABS:A00E gplvec
GPLWS ABS:83E0 gplws
GR4 ABS:83E8 gr4
GR6 ABS:83EC gr6
GRMRA ABS:9802 grmra
GRMRD ABS:9800 grmrd
GRMWA ABS:9C02 grmwa
GRMWD ABS:9C00 grmwd
GT ABS:6488 gt
GTE ABS:64A4 gte
GTEH ABS:649E gteh
GTEZ ABS:6548 gtez
GTEZH ABS:6540 gtezh
GTH ABS:6482 gth
GTZ ABS:64FE gtz
GTZH ABS:64F8 gtzh
GXMAX ABS:77A6 gxmax
GXMLAD ABS:7E5A gxmlad
H20 ABS:6AEC h20
HAA ABS:A176 haa
HCHAR ABS:7970 hchar
HCHARH ABS:7966 hcharh
HDOTH ABS:787A hdoth
HDR0 ABS:6C98 hdr0
HDR1 ABS:6CA6 hdr1
HEADER ABS:6F42 header
HEADR ABS:6F4C headr
HEADRH ABS:6F38 headrh
HELP ABS:7743 help
HERE ABS:A046 here
HERE_ ABS:76EC here_
HEREH ABS:76E6 hereh
HEX ABS:77C4 hex
HEXDOT ABS:7880 hexdot
HEXH ABS:77BC hexh
HFREE ABS:6940 hfree
HFREEH ABS:6936 hfreeh
HHEREH ABS:7806 hhereh
HIDEME ABS:721C hideme
HIDH ABS:7212 hidh
HIMEM ABS:A2C6 himem
HLINE ABS:75A6 hline
HTIBH ABS:7650 htibh
ICOMP ABS:727A icomp
ICOMPH ABS:726C icomph
IERR ABS:7356 ierr
IF ABS:659C if
IFCNT ABS:A07C ifcnt
IFERR ABS:7558 iferr
IFH ABS:6596 ifh
IGLZ ABS:6E5E iglz
IMM ABS:7232 imm
IMMED ABS:8000 immed
IMMH ABS:7224 immh
IN ABS:A042 in
IN_ ABS:770C in_
INCYC ABS:72D2 incyc
INH ABS:7704 inh
INIT ABS:7B76 init
INIT1 ABS:7BDC init1
INS1 ABS:7352 ins1
INSOVR ABS:7340 insovr
INSTXT ABS:76FF instxt
INTERP ABS:72FE interp
INTGO ABS:730A intgo
INTH ABS:72F0 inth
INTLP ABS:730C intlp
INTOUT ABS:73A6 intout
INTVEC ABS:A000 intvec
INTXT ABS:75AB intxt
INV_ ABS:6800 inv_
INVH ABS:67F8 invh
INVLOP ABS:7C78 invlop
IOERR ABS:6ADE ioerr
IOERR1 ABS:7796 ioerr1
IOERRH ABS:778C ioerrh
IS80C ABS:767A is80c
ISDBL ABS:A052 isdbl
ISR ABS:83C4 ISR
ISRDES ABS:607A isrdes
ISRNXT ABS:6084 isrnxt
ISROUT ABS:608C isrout
ISRXIT ABS:8354 isrxit
ISSERR ABS:7204 isserr
ISSPCH ABS:6684 isspch
JOYST ABS:6D88 joyst
JOYSTH ABS:6D7E joysth
KEEPN2 ABS:640C keepn2
KEY ABS:6DD6 key
KEYBD ABS:75E8 keybd
KEYCC ABS:FFFFFF83 keyCC
KEYCCR ABS:704C keyccr
KEYCD ABS:FFFFFF84 keyCD
KEYCD1 ABS:6FBA keycd1
KEYCDR ABS:6FA0 keycdr
KEYCI ABS:FFFFFF89 keyCI
KEYCI1 ABS:7014 keyci1
KEYCI2 ABS:7038 keyci2
KEYCIR ABS:6FF6 keycir
KEYCO ABS:FFFFFF8F keyCO
KEYCOR ABS:6F74 keycor
KEYCP ABS:FFFFFF90 keyCP
KEYCPR ABS:6F8E keycpr
KEYCV ABS:FFFFFF96 keyCV
KEYCVR ABS:706E keyCVr
KEYD ABS:718C keyd
KEYD1 ABS:71A6 keyd1
KEYD2 ABS:71AE keyd2
KEYDEV ABS:A022 keydev
KEYDX ABS:71D2 keydx
KEYE ABS:720A keye
KEYEN1 ABS:6F6E keyen1
KEYF1 ABS:0003 keyF1
KEYF1R ABS:709E keyf1r
KEYF1S ABS:70CC keyf1s
KEYF2 ABS:0004 keyF2
KEYF2R ABS:7180 keyf2r
KEYF3 ABS:0007 keyF3
KEYF3R ABS:7110 keyf3r
KEYF4 ABS:0002 keyF4
KEYF7 ABS:0001 keyF7
KEYF7R ABS:7142 keyf7r
KEYF9 ABS:000F keyF9
KEYF9R ABS:7102 keyf9r
KEYFD ABS:0009 keyFD
KEYFE ABS:000B keyFE
KEYFEQ ABS:0005 keyFeq
KEYFQR ABS:715C keyfqr
KEYFS ABS:0008 keyFS
KEYFX ABS:000A keyFX
KEYIN ABS:8375 keyin
KEYQ ABS:6E62 keyq
KEYQH ABS:6E5A keyqh
KEYQSR ABS:6E6A keyqsr
KEYRET ABS:000D keyRET
KEYS ABS:71D4 keys
KEYX ABS:7230 keyx
KMODE ABS:771E kmode
KMODH ABS:7714 kmodh
KSCN ABS:6DE2 kscn
KSCN1 ABS:6DE4 kscn1
KSCN2 ABS:6E08 kscn2
KSCNH ABS:6DCE kscnh
L8000 ABS:6B36 l8000
LAGAIN ABS:674C lagain
LASTWD ABS:7F10 lastwd
LATES_ ABS:76DE lates_
LATESH ABS:76D4 latesh
LATEST ABS:A044 latest
LBASE ABS:A05E lbase
LBRACE ABS:7E2E lbrace
LBRACK ABS:70FA lbrack
LBRAKH ABS:70F4 lbrakh
LDGADD ABS:0060 ldgadd
LDVDPL ABS:61BE ldvdpl
LDVDPR ABS:61B6 ldvdpr
LEAVE ABS:6788 leave
LEAVEH ABS:677E leaveh
LFREE ABS:695A lfree
LFREEH ABS:6950 lfreeh
LFT1 ABS:7546 lft1
LFTLIN ABS:752E lftlin
LHL ABS:7448 lhl
LHL1 ABS:745E lhl1
LINK ABS:0000 link
LINNUM ABS:75C3 linnum
LIST_ ABS:7BB4 list_
LIST1 ABS:7BC8 list1
LISTH ABS:7BAC listh
LIT ABS:70B2 lit
LIT0 ABS:6084 lit0
LIT1 ABS:608C lit1
LIT8 ABS:6094 lit8
LITERH ABS:70B4 literh
LITH ABS:70AA lith
LITM1 ABS:609C litm1
LITRAL ABS:70C0 litral
LMATCH ABS:6AFE lmatch
LNKERR ABS:6ADC lnkerr
LNKSLN ABS:6A2A lnksln
LNKSLP ABS:6A10 lnkslp
LOAD ABS:7C18 load
LOADH ABS:7C10 loadh
LOADLP ABS:66B6 loadlp
LOCSPH ABS:79F8 locsph
LOCSPR ABS:7A04 locspr
LOGO ABS:7E26 logo
LOMADJ ABS:6CE6 lomadj
LOOP ABS:673E loop
LOOP1 ABS:6718 loop1
LOOP1H ABS:6710 loop1h
LOOP2 ABS:6726 loop2
LOOPCH ABS:6742 loopchk
LOOPH ABS:6734 looph
LOOPX ABS:6744 loopx
LOWCAS ABS:7D56 lowcas
LSFT ABS:680C lsft
LSFTH ABS:6806 lsfth
LSTBLK ABS:A1B4 lstblk
LSTXIT ABS:7BF8 lstxit
LT ABS:6496 lt
LTE ABS:64B4 lte
LTEH ABS:64AE lteh
LTEZ ABS:6536 ltez
LTEZH ABS:652E ltezh
LTH ABS:6490 lth
LTZ ABS:64F0 ltz
LTZH ABS:64EA ltzh
LZI ABS:A062 lzi
MAGFY ABS:79CC magfy
MAGFYH ABS:79C0 magfyh
MARK ABS:655A mark
MARKR ABS:6F5E markr
MARKRH ABS:6F54 markrh
MAX ABS:641A max
MAXH ABS:6412 maxh
MEMPTR ABS:7E34 memptr
MENU ABS:600C menu
MENU40 ABS:6026 menu40
MIN ABS:6404 min
MINH ABS:63FC minh
MKBLK ABS:7D2C mkblk
MKBLKC ABS:7D34 mkblkc
MKBLKH ABS:7D22 mkblkh
MKCLSE ABS:6964 mkclse
MKDERR ABS:6970 mkderr
MKDSKL ABS:691E mkdskl
MOD ABS:63D6 mod
MODH ABS:63CE modh
MODMAX ABS:7372 modmax
MODTXT ABS:76FA modtxt
MPADJ ABS:6CDA mpadj
MTBUF ABS:7CB2 mtbuf
MTBUFH ABS:7CA0 mtbufh
MTBUFL ABS:685C mtbufl
MTEXT ABS:602B mtext
MUL ABS:632E mul
MUL2 ABS:62F6 mul2
MUL2H ABS:62F0 mul2h
MUL3 ABS:62F8 mul3
MULH ABS:6328 mulh
NAMONE ABS:6A9C namone
NAMPTR ABS:8356 namptr
NAMSTO ABS:A178 namsto
NAMTWO ABS:6AA4 namtwo
NBLK ABS:7B60 nblk
NBLKH ABS:7B58 nblkh
NBUF ABS:7624 nbuf
NBUFH ABS:761C nbufh
NCOS ABS:72CC ncos
NCOS1 ABS:72E4 ncos1
NDIRT ABS:689A ndirt
NDSH ABS:6248 ndsh
NEEDUD ABS:7616 needud
NEG_ ABS:63E8 neg_
NEG2 ABS:63EA neg2
NEGH ABS:63DE negh
NEQ ABS:64C4 neq
NEQHH ABS:64BE neqhh
NEQZ ABS:64E2 neqz
NEQZH ABS:64DA neqzh
NEXIT ABS:6C7A nexit
NEXT ABS:000C NEXT
NEXT1K ABS:694C next1k
NEXTH ABS:6584 nexth
NFERR ABS:749E nferr
NFTXT ABS:75A1 nftxt
NIMM ABS:7344 nimm
NINN ABS:6E46 ninn
NIP ABS:61D2 nip
NIPH ABS:61CA niph
NOBOOT ABS:73C2 noboot
NOBOOT ABS:753A nobootm
NOCODE ABS:738C nocode
NODBL ABS:737C nodbl
NODSR ABS:6AD8 nodsr
NOIMM ABS:6B44 noimm
NOKEY ABS:FF00 nokey
NOMATC ABS:6B48 nomatch
NOOFF ABS:6A56 nooff
NOPAST ABS:709C nopast
NOROM ABS:6A50 norom
NOSCR ABS:7638 noscr
NOSCRH ABS:762C noscrh
NOSCRL ABS:A026 noscrl
NOTFND ABS:7424 notfnd
NOTICK ABS:72E6 notick
NOWORD ABS:6B74 noword
NROT ABS:61AC nrot
NROTH ABS:61A4 nroth
NSPK ABS:664A nspk
NTS ABS:789E nts
NTS1 ABS:78A6 nts1
NTSH ABS:7896 ntsh
NUM0 ABS:6BEA num0
NUM1 ABS:6C14 num1
NUM2 ABS:6C20 num2
NUM3 ABS:6C28 num3
NUM4 ABS:6BEE num4
NUM5 ABS:6BFA num5
NUMBER ABS:6B76 number
NUMBR1 ABS:6B82 numbr1
NUMBRH ABS:6B6C numbrh
NUMEND ABS:6C70 numend
NUMGO ABS:6C54 numgo
NUMISD ABS:6C50 numisd
NUMISL ABS:6C4A numisl
NUMLZ ABS:6C2C numlz
NUMVEC ABS:A004 numvec
NXTDAT ABS:7C9E nxtdat
NXTDIG ABS:6E4C nxtdig
NXTFB ABS:6990 nxtfb
NXTREC ABS:6950 nxtrec
NXTSLT ABS:79B2 nxtslt
OF ABS:6612 of
OFCNT ABS:A084 ofcnt
OFERR ABS:71CA oferr
OFH ABS:660C ofh
OFTXT ABS:7579 oftxt
OHSHIT ABS:6C44 ohshit
OK ABS:7362 ok
OKTXT ABS:6150 oktxt
OKX ABS:7364 okx
ONCSR ABS:6F48 oncsr
OPEN ABS:0000 open
OR_ ABS:67E0 or_
ORH ABS:67DA orh
OVER ABS:61C8 over
OVERH ABS:61C0 overh
OVR ABS:7368 ovr
OVRTXT ABS:7705 ovrtxt
PABBUF ABS:A182 pabbuf
PABCC ABS:A185 pabcc
PABFIL ABS:A18A pabfil
PABFLG ABS:A181 pabflg
PABLOC ABS:1B78 pabloc
PABLRL ABS:A184 pablrl
PABNLN ABS:A189 pabnln
PABOPC ABS:A180 pabopc
PABREC ABS:A186 pabrec
PABSCO ABS:A188 pabsco
PAD ABS:7776 pad
PADEND ABS:7F44 padend
PADH ABS:776E padh
PADVEC ABS:A010 padvec
PADX ABS:7786 padx
PAE ABS:6D68 PAE
PANC ABS:A036 panc
PANEL ABS:7A82 panel
PANELH ABS:7A78 panelh
PANR ABS:A034 panr
PANXY ABS:A032 panxy
PARSNM ABS:6BBE parsnm
PATCH ABS:A06A patch
PC ABS:0003 pc
PCREAT ABS:A018 pcreate
PDOCON ABS:A016 pdocon
PICK ABS:6212 pick
PICKH ABS:620A pickh
PICKX ABS:78C2 pickx
PITCH ABS:0023 pitch
PLOOH1 ABS:6750 plooh1
PLOOP ABS:6778 ploop
PLOOP1 ABS:675A ploop1
PLOOPH ABS:676C plooph
PLUS1 ABS:62BA plus1
PLUS1H ABS:62B4 plus1h
PLUS2 ABS:62CE plus2
PLUS2H ABS:62C8 plus2h
PNEXT ABS:A014 pnext
PRGTOP ABS:A2C6 prgtop
PTOH ABS:707A ptoh
PUSHER ABS:6C88 pusher
PWR ABS:6E10 pwr
PWROUT ABS:6E20 pwrout
QDUP ABS:61FC qdup
QDUPX ABS:6208 qdupx
QUIT ABS:6124 quit
QUITH ABS:611C quith
QUITKY ABS:009D quitky
QUITLP ABS:6126 quitlp
R0 ABS:0000 R0
R1 ABS:0001 R1
R10 ABS:000A R10
R11 ABS:000B R11
R12 ABS:000C R12
R13 ABS:000D R13
R14 ABS:000E R14
R15 ABS:000F R15
R2 ABS:0002 R2
R3 ABS:0003 R3
R4 ABS:0004 R4
R5 ABS:0005 R5
R6 ABS:0006 R6
R7 ABS:0007 R7
R8 ABS:0008 R8
R9 ABS:0009 R9
RBRACK ABS:7108 rbrack
RBRAKH ABS:7102 rbrakh
RDFER1 ABS:74CC rdfer1
RDFERR ABS:74B6 rdferr
RDFTXT ABS:7586 rdftxt
READ ABS:0002 read
READSP ABS:669C readsp
RECBUF ABS:1BA0 recbuf
RECLN0 ABS:7A5C recln0
RECRSH ABS:7286 recrsh
RECURS ABS:7292 recurs
REFDN ABS:67C2 refdn
REFILL ABS:0008 refill
REFUP ABS:67BA refup
REM ABS:6A6C rem
REMH ABS:6A66 remh
REPEAT ABS:66CC repeat
REPETH ABS:66C2 repeth
REPXIT ABS:752A repxit
RET4TH ABS:710C ret4th
RETB0 ABS:833A retB0
RETBNK ABS:A06E retbnk
RETSTK ABS:A28A retstk
RL1 ABS:747A rl1
RLOOP ABS:7504 rloop
RND ABS:781E rnd
RNDH ABS:7816 rndh
RNDX ABS:6D5C rndx
ROLL ABS:622E roll
ROLLH ABS:6226 rollh
ROLLLP ABS:78DA rolllp
ROMSPK ABS:60FA romspk
ROMSPX ABS:612E romspx
ROT ABS:6190 rot
ROTH ABS:6188 roth
ROWNUM ABS:746C rownum
ROWTXT ABS:76E4 rowtxt
RPF ABS:76BC rpf
RPFH ABS:76B4 rpfh
RRSTAC ABS:6154 rrstack
RS0 ABS:A020 rs0
RSC ABS:629E rsc
RSCH ABS:6298 rsch
RSFT ABS:681E rsft
RSFTH ABS:6818 rsfth
RSPOP ABS:62AC rspop
RSPOPH ABS:62A6 rspoph
RSPSHH ABS:628A rspshh
RSPUSH ABS:6290 rspush
RSRC ABS:74DC rsrc
RSRC_ ABS:74EC rsrc_
RSRC1 ABS:7500 rsrc1
RSTACK ABS:0005 rstack
RSTSP ABS:6AEE rstsp
RSTSP1 ABS:6AF6 rstsp1
RSTSP3 ABS:6B02 rstsp3
RT1 ABS:756E rt1
RT2 ABS:7578 rt2
RT4TH ABS:6F84 rt4th
RTDATA ABS:7AF6 rtdata
RTDATH ABS:7AEC rtdath
RTLIN ABS:7550 rtlin
RTNAD ABS:7E58 rtnad
RU80C ABS:73E6 ru80c
RUNISR ABS:834C runisr
S0 ABS:A01E s0
S0_ ABS:77B4 s0_
S0H ABS:77AE s0h
S32COL ABS:61AC s32col
S40COL ABS:61A6 s40col
S80COL ABS:61B2 s80col
SAL ABS:A088 sal
SAMS ABS:7BA6 sams
SAMS_ ABS:692E sams_
SAMSH ABS:6926 samsh
SAV8A ABS:A148 sav8a
SAVCRU ABS:A14A savcru
SAVENT ABS:A14C savent
SAVKEY ABS:A028 savkey
SAVLEN ABS:A14E savlen
SAVPAB ABS:A150 savpab
SAVVER ABS:A152 savver
SAY ABS:7AA6 say
SAYH ABS:7A9E sayh
SAYXIT ABS:6664 sayxit
SCLUP_ ABS:6EBE sclup_
SCNBLK ABS:69A0 scnblk
SCNKEY ABS:75BE scnkey
SCNKY1 ABS:75DE scnky1
SCNNXT ABS:69A8 scnnxt
SCREEN ABS:7A5E screen
SCRLNO ABS:6F0A scrlno
SCRLUP ABS:6EAA scrlup
SCRLUT ABS:6432 scrlut
SCRNH ABS:7A54 scrnh
SCROLH ABS:7A66 scrolh
SCROLL ABS:7A70 scroll
SCRX ABS:A028 scrX
SCRY ABS:A02A scrY
SDELIM ABS:A050 sdelim
SDIV ABS:63C6 sdiv
SDIV1 ABS:642C sdiv1
SDIV2 ABS:6438 sdiv2
SDIV3 ABS:643C sdiv3
SDIVH ABS:63C0 sdivh
SEED ABS:A076 seed
SEMI ABS:7186 semi
SEMI2 ABS:71F4 semi2
SEMI3 ABS:7200 semi3
SEMIH ABS:7180 semih
SENS ABS:7648 sens
SENSH ABS:7640 sensh
SETBLH ABS:7D10 setblh
SETBLK ABS:7D1A setblk
SETW ABS:786C setw
SFALSE ABS:6556 sFalse
SGET3 ABS:658A sget3
SGET4 ABS:6588 sget4
SGET5 ABS:6586 sget5
SGO ABS:6A7A sgo
SGO2 ABS:6A80 sgo2
SIDIV ABS:6422 sidiv
SIGN ABS:78AC sign
SIGNDO ABS:6452 signdo
SIMUL ABS:645C simul
SIMUL1 ABS:6472 simul1
SKIPBS ABS:6A30 skipbs
SKIPLD ABS:60FC skipld
SKIPUD ABS:7638 skipud
SMLIST ABS:A108 smlist
SMLST ABS:7A28 smlst
SMLSTH ABS:7A1E smlsth
SMOD ABS:6362 smod
SMOD1 ABS:6370 smod1
SMODH ABS:635A smodh
SNDXIT ABS:7F0E sndxit
SOUND ABS:7ED8 sound
SOUNDH ABS:7ECE soundh
SOURCE ABS:A058 source
SPACE1 ABS:6D38 space1
SPACEH ABS:6D2E spaceh
SPADDR ABS:66B2 spaddr
SPADR ABS:A03C spadr
SPAN ABS:7658 span
SPAN1 ABS:765E span1
SPCES ABS:6D52 spces
SPCES1 ABS:6D5C spces1
SPCESH ABS:6D48 spcesh
SPCESX ABS:6D6C spcesx
SPCHRD ABS:9000 spchrd
SPCHWT ABS:9400 spchwt
SPCHX ABS:669A spchx
SPCNT ABS:A03A spcnt
SPCSVC ABS:A03E spcsvc
SPDATA ABS:834A spdata
SPEECH ABS:607C speech
SPF ABS:769A spf
SPFH ABS:7692 spfh
SPKNG ABS:7A96 spkng
SPKNGH ABS:7A8A spkngh
SPKROM ABS:662A spkROM
SPPATH ABS:7A0C sppath
SPRCLH ABS:79D4 sprclh
SPRCOL ABS:79DE sprcol
SPREAD ABS:6628 spread
SPRITE ABS:79B8 sprite
SPRITH ABS:79AE sprith
SPRLCH ABS:79E6 sprlch
SPRLOC ABS:79F0 sprloc
SPRMOV ABS:7A3A sprmov
SPRMV1 ABS:63BE sprmv1
SPRMVH ABS:7A30 sprmvh
SPRPAT ABS:7A16 sprpat
SPRTX ABS:62E0 sprtx
SPS ABS:76A8 sps
SPSH ABS:76A0 spsh
SPSTAT ABS:8340 spstat
SPSX ABS:76B0 spsx
SPWORD ABS:72B2 spword
SPYES ABS:6696 spyes
SROM ABS:6A46 srom
SSFLAG ABS:6629 ssflag
SSLASH ABS:6330 sslash
SSM ABS:6386 ssm
SSMH ABS:637C ssmh
STACK ABS:0004 stack
STACKS ABS:A254 stacks
STADD ABS:6860 stadd
STADDH ABS:685A staddh
START4 ABS:6052 start40
START8 ABS:605C start80
STARTB ABS:606E startB0
STARTB ABS:606E startB1
STATE_ ABS:76CC state_
STATE0 ABS:7338 state0
STATEH ABS:76C2 stateh
STATUS ABS:0009 status
STB ABS:6880 stb
STBH ABS:687A stbh
STKPNT ABS:8373 stkpnt
STKTXT ABS:75AF stktxt
STKUF ABS:73CC stkuf
STKUFH ABS:73C4 stkufh
STKX ABS:73E2 stkx
STOR0H ABS:688C stor0h
STOR0X ABS:6898 stor0x
STORE ABS:6852 store
STORE0 ABS:6892 store0
STOREH ABS:684C storeh
STR ABS:791E str
STRBUF ABS:A242 strbuf
STRC1 ABS:6D9C strc1
STRCU ABS:60F4 strcu
STRH ABS:7916 strh
STRING ABS:7900 string
STRM ABS:7AB8 strm
STRMH ABS:7AAE strmh
STRNB ABS:60DE strnb
STRNG1 ABS:790E strng1
STRNGH ABS:78FA strngh
STRSP2 ABS:60A6 strsp2
STRSP3 ABS:60C4 strsp3
STRSPK ABS:6090 strspk
STRUE ABS:6552 sTrue
STRXIT ABS:60F2 strxit
SUB ABS:6326 sub
SUB1 ABS:62C2 sub1
SUB1H ABS:62BC sub1h
SUB2 ABS:62EE sub2
SUB2H ABS:62E8 sub2h
SUBH ABS:6320 subh
SUMODE ABS:A078 sumode
SWAP ABS:617C swap
SWAPH ABS:6174 swaph
SWPB_ ABS:6220 swpb_
SWPBH ABS:621A swpbh
SYNTH ABS:60FE synth
SYNYES ABS:A040 synyes
TBODYH ABS:6C08 tbodyh
TEMP ABS:A070 temp
TEMP2 ABS:A072 temp2
TEMP3 ABS:A074 temp3
TERM1 ABS:60BE term1
TESTLZ ABS:6E78 testlz
TFNL ABS:7918 tfnl
THEN ABS:65B4 then
THENH ABS:65AC thenh
THRU ABS:7B7A thru
THRUH ABS:7B72 thruh
THRULP ABS:7B84 thrulp
TIB ABS:3420 tib
TIB_ ABS:773E tib_
TIBADR ABS:A1CE tibadr
TIBH ABS:7736 tibh
TIBSIZ ABS:A04A tibsiz
TICK ABS:7242 tick
TICK2 ABS:7250 tick2
TICK2H ABS:724A tick2h
TICKH ABS:723A tickh
TLUT ABS:6E7E tlut
TOBODY ABS:6C12 tobody
TOH ABS:7034 toh
TOHX ABS:704A tohx
TOOBIG ABS:6916 toobig
TOOSML ABS:6910 toosml
TORAM ABS:7EB8 toRAM
TOTBLK ABS:A1B0 totblk
TOTERM ABS:60B6 toterm
TOUTIL ABS:708C ToUtil
TRAIL ABS:7934 trail
TRAIL1 ABS:6D84 trail1
TRAIL2 ABS:6D7C trail2
TRAILH ABS:7926 trailh
TRCOM ABS:6A7E trcom
TRCOM1 ABS:6BB2 trcom1
TRCOMH ABS:6A78 trcomh
TRLOUT ABS:6D82 trlout
TRUE ABS:77F0 true
TRUEH ABS:77E8 trueh
TRUL1 ABS:73DC trul1
TSTRH ABS:793C tstrh
TUCK ABS:61E0 tuck
TUCKH ABS:61D8 tuckh
TXT0 ABS:7684 txt0
TXT1 ABS:76A3 txt1
TXT2 ABS:76C2 txt2
TYPCMH ABS:6A86 typcmh
TYPE ABS:6C94 type
TYPE1 ABS:6C96 type1
TYPEH ABS:6C8C typeh
TYPLP ABS:6CA4 typlp
TYPOUT ABS:6CB4 typout
TYPST1 ABS:7950 typst1
TYPSTR ABS:7942 typstr
UDOT ABS:782C udot
UDOTH ABS:7826 udoth
UDOTR ABS:784E udotr
UDOTRH ABS:7846 udotrh
ULESS ABS:650C uless
ULESSH ABS:6506 ulessh
UMODH ABS:63A2 umodh
UMSH ABS:6340 umsh
UNBAL ABS:74AC unbal
UNTIL ABS:6686 until
UNTILH ABS:667C untilh
UPDATE ABS:7C86 update
UPDATH ABS:7C7C updath
UPKEY ABS:72E8 upkey
USE ABS:7B06 use
USE1 ABS:7B0E use1
USEH ABS:7AFE useh
USEXIT ABS:671A usexit
USIGN ABS:78B4 usign
USIGND ABS:7602 usignd
USIGNH ABS:75F6 usignh
USMOD ABS:63AC usmod
USRISR ABS:A008 usrisr
VALUE ABS:702E value
VALUEH ABS:7024 valueh
VAR ABS:701A var
VARH ABS:700E varh
VBLNK ABS:83D7 vblnk
VCHAR ABS:7982 vchar
VCHAR1 ABS:626E vchar1
VCHAR2 ABS:627A vchar2
VCHARH ABS:7978 vcharh
VDPA ABS:8C02 vdpa
VDPFH ABS:68A6 vdpfh
VDPFTC ABS:68AC vdpftc
VDPM ABS:6918 vdpm
VDPR ABS:8800 vdpr
VDPR1 ABS:A06C vdpr1
VDPRW ABS:68E8 vdprw
VDPRWH ABS:68E0 vdprwh
VDPSTR ABS:68C0 vdpstr
VDPW ABS:8C00 vdpw
VDPWH ABS:68BA vdpwh
VDPWW ABS:7D58 vdpww
VDPWWH ABS:68CE vdpwwh
VDPX ABS:6924 vdpx
VFIND ABS:6AE4 vfind
VLINE ABS:7592 vline
VLINE1 ABS:7598 vline1
VMBR ABS:7F82 vmbr
VMBR1 ABS:7F92 vmbr1
VMBRH ABS:68FA vmbrh
VMBW ABS:7FC2 vmbw
VMBW0 ABS:7FD0 vmbw0
VMBW1 ABS:7FE4 vmbw1
VMBWH ABS:690A vmbwh
VREAD ABS:6B90 vread
VREAD1 ABS:6B92 vread1
VREAD2 ABS:6B96 vread2
VSBR ABS:7F60 vsbr
VSBW ABS:7F9A vsbw
VSBW0 ABS:7FA8 vsbw0
VSBWMI ABS:7880 vsbwmi
WARN ABS:772E warn
WARNH ABS:7726 warnh
WFNLB ABS:7928 wfnlb
WFTXT ABS:6D10 wftxt
WHEAD ABS:7D3C whead
WHERE ABS:7B20 where
WHERE1 ABS:7B40 where1
WHEREH ABS:7B16 whereh
WHILE ABS:66BA while
WHILEH ABS:66B0 whileh
WITHH ABS:6514 withh
WITHIN ABS:651E within
WKSPC ABS:8300 wkspc
WORD ABS:6AA2 word
WORD0 ABS:6AA8 word0
WORD1 ABS:6ABA word1
WORD2 ABS:6AB6 word2
WORDH ABS:6A9A wordh
WORDS_ ABS:6CC2 words_
WORDS1 ABS:6CCA words1
WORDS2 ABS:6D02 words2
WORDS3 ABS:6CE8 words3
WORDS4 ABS:6CEA words4
WORDSH ABS:6CB8 wordsh
WP ABS:A012 wp
WRAP ABS:A030 wrap
WRAP_ ABS:7678 wrap_
WRAPH ABS:7670 wraph
WRD1 ABS:6B3E wrd1
WRD2 ABS:6B52 wrd2
WRDBUF ABS:A1D0 wrdbuf
WRDFIN ABS:6B70 wrdfin
WRDGB ABS:6B86 wrdgb
WRDXIT ABS:6B7C wrdxit1
WRDXIT ABS:6B82 wrdxit2
WRITE ABS:0003 write
WRKBUF ABS:A222 wrkbuf
WSTR ABS:75B2 wstr
WWRAP ABS:7614 wwrap
WWRAPH ABS:760A wwraph
XMAX ABS:A02C xmax
XMAXH ABS:779E xmaxh
XMLRTN ABS:7E90 xmlrtn
XOR_ ABS:67EE xor_
XORH ABS:67E6 xorh
XTAB27 ABS:200E xtab27
XTHRU ABS:7B8C xthru
XUGLY ABS:6BE2 xugly
XY ABS:6D1E xy
XYA ABS:7580 xya
XYH ABS:6D16 xyh
YMAX ABS:A02E ymax
ZBQ ABS:7F40 zbq
ZBRCHH ABS:65EA zbrchh
ZBRNCH ABS:65F6 zbrnch
ZCHARS ABS:6A5E zchars
ZEROCH ABS:7E4E zerochr
ZEROS ABS:768A zeros
ZEROSH ABS:7680 zerosh